Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 672 lines (592 sloc) 17.713 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (**
19 Interface between the compiler and the standard library.
20 Contain identifier and bslkeys of all opa functions inserted by the compiler.
21 *)
22
23 (**
24 The hierachy of ocaml values follows the module hierarchy of opa values.
25 The hierarchy must be respected.
26 All ident content are opa pathes where dot has been replaced by '_'.
27 Define ONLY CONSTANT STRING
28
29 A check (cf checkopacapi.ml), called during mkinstall check that:
30 - there is a strict equality between bypasses marked as [[opacapi]]
31 in the bsl and bypass available there,
32 - there is a strict equality between identifiers marked as [\@opacapi]
33 in the stdlib and identifier available there.
34 *)
35
36 let table = Hashtbl.create 128
37 let (!!) s =
38 if Hashtbl.mem table s then (prerr_endline s; assert false);
39 Hashtbl.add table s s;
40 s
41
42 (* toplevel *)
43 let (==) = !! "=="
44 let (!=) = !! "!="
45 let identity = !! "identity"
46 let internal__add_css_entry = !! "__internal__add_css_entry"
47 let magicToString = !! "magicToString"
48 let magicToXml = !! "magicToXml"
49 let never_do_anything = !! "never_do_anything"
50 let none = !! "none"
51 let callFA = !! "callFA"
52 let some = !! "some"
53 let unary_minus = !! "unary_minus"
54 let unary_minus_dot = !! "unary_minus_dot"
55
56 module Client_code =
57 struct
58 let (!!) s = !! ("Client_code_" ^ s)
59 let register_css_declaration = !! "register_css_declaration"
60 let register_js_code = !! "register_js_code"
61 let register_js_code_elt = !! "register_js_code_elt"
62 end
63
64 module DbVirtual =
65 struct
66 let (!!) s = !! ("DbVirtual_" ^ s)
67 let hack_coerce_default = !! "hack_coerce_default"
68 let hack_coerce_option = !! "hack_coerce_option"
69 let hack_coerce_vvpath = !! "hack_coerce_vvpath"
70 let hack_coerce_vrpath = !! "hack_coerce_vrpath"
71 let make_ref = !! "make_ref"
72 let make_val = !! "make_val"
73 end
74
75 module Dom =
76 struct
77 let (!!) s = !! ("Dom_" ^ s)
78 let select_class = !! "select_class"
79 let select_id = !! "select_id"
80 end
81
82 module Core_server_code =
83 struct
84 let (!!) s = !! ("Core_server_code_" ^ s)
85 let register_server_code = !! "register_server_code"
86 end
87
88 module FiniteSingleThreadLazy =
89 struct
90 let (!!) s = !! ("FiniteSingleThreadLazy_" ^ s)
91 let force = !! "force"
92 end
93
94 module FunActionServer =
95 struct
96 let (!!) s = !! ("FunActionServer_" ^ s)
97 let serialize_argument = !! "serialize_argument"
98 let serialize_call = !! "serialize_call"
99 let serialize_ty_argument = !! "serialize_ty_argument"
100 end
101
4692879 @OpaOnWindowsNow [feature] Internationalisation: add @i18n directive and start support fo...
OpaOnWindowsNow authored
102 module I18n =
103 struct
104 let (!!) s = !! ("I18n_" ^ s)
105 let lang = !! "lang"
106 end
107
fccc685 Initial open-source release
MLstate authored
108 module IntMap =
109 struct
110 let (!!) s = !! ("IntMap_" ^ s)
111 let add = !! "add"
112 let empty = !! "empty"
113 let fold = !! "fold"
114 end
115
eafacd5 @OpaOnWindowsNow [cleanup] opacapi,{list,xhtml}.opa: respect opacapi guidelines
OpaOnWindowsNow authored
116 module List =
117 struct
118 let (!!) s = !! ("List_"^s)
119 let split_at_opt = !! "split_at_opt"
120 let split_between = !! "split_between"
121 end
122
fccc685 Initial open-source release
MLstate authored
123 module Mutable =
124 struct
125 let (!!) s = !! ("Mutable_" ^ s)
126 let make = !! "make"
127 let set = !! "set"
128 end
129
130 module Opa2Js =
131 struct
132 let (!!) s = !! ("Opa2Js_" ^ s)
133 let to_string = !! "to_string"
134 end
135
136 module OpaRPC =
137 struct
138 let (!!) s = !! ("OpaRPC_" ^ s)
139 let add_args_with_type = !! "add_args_with_type"
140 let add_var_types = !! "add_var_types"
141 let add_row_types = !! "add_row_types"
142 let add_col_types = !! "add_col_types"
143 let client_async_send_to_server = !! "Client_async_send_to_server"
144 let client_dispatcher_register = !! "Client_Dispatcher_register"
145 let client_send_to_server = !! "Client_send_to_server"
146 let client_try_cache = !! "Client_try_cache"
147 let empty_request = !! "empty_request"
148 let error_stub = !! "error_stub"
149 let extract_types = !! "extract_types"
150 let extract_values = !! "extract_values"
151 let fake_stub = !! "fake_stub"
152 let serialize = !! "serialize"
24f427d [feature] rpc runtime and compiler: implementing asynchronous server->cl...
Valentin Gatien-Baron authored
153 let server_async_send_to_client = !! "Server_async_send_to_client"
fccc685 Initial open-source release
MLstate authored
154 let server_dispatcher_register = !! "Server_Dispatcher_register"
155 let server_send_to_client = !! "Server_send_to_client"
156 let server_try_cache = !! "Server_try_cache"
157 let unserialize = !! "unserialize"
158 end
159
160 module OpaSerialize =
161 struct
162 let (!!) s = !! ("OpaSerialize_" ^ s)
163 let serialize = !! "serialize"
164 let serialize_for_js = !! "serialize_for_js"
165 let unserialize = !! "unserialize"
166 let unserialize_ty = !! "unserialize_ty"
167 let unserialize_unsafe = !! "unserialize_unsafe"
168 end
169
170 module OpaTsc =
171 struct
172 let (!!) s = !! ("OpaTsc_" ^ s)
173 let implementation = !! "implementation"
174 end
175
176 module OpaType =
177 struct
178 let (!!) s = !! ("OpaType_" ^ s)
179 let instantiate_row = !! "instantiate_row"
180 let instantiate_col = !! "instantiate_col"
181 end
182
183 module OpaValue =
184 struct
185 let (!!) s = !! ("OpaValue_" ^ s)
186 let add_compare = !! "add_compare"
187 let add_serializer = !! "add_serializer"
188 let add_to_string = !! "add_to_string"
189 let add_xmlizer = !! "add_xmlizer"
190 end
191
192 module Parser =
193 struct
194 let (!!) s = !! ("Parser_" ^ s)
195 let of_string = !! "of_string"
196 end
197
198 module Resource_private =
199 struct
200 let (!!) s = !! ("Resource_private_"^s)
201 let content_of_include = !!"content_of_include"
202 let make_include = !! "make_include"
203 let make_resource_include = !! "make_resource_include"
204 let raw_resource_factory = !! "raw_resource_factory"
205 end
206
8edc001 [feature] adding: an @async directive on bindings to perform asynchronou...
Valentin Gatien-Baron authored
207 module Scheduler =
208 struct
209 let (!!) s = !! ("Scheduler_" ^ s)
210 let push = !! "push"
211 end
212
fccc685 Initial open-source release
MLstate authored
213 module Server_private =
214 struct
215 let (!!) s = !! ("Server_private_" ^ s)
216 let add_service = !! "add_service"
217 let run_services = !! "run_services"
218 end
219
4692879 @OpaOnWindowsNow [feature] Internationalisation: add @i18n directive and start support fo...
OpaOnWindowsNow authored
220 module String =
221 struct
222 let (!!) s = !! ("String_" ^ s)
223 let flatten = !! "flatten"
224 end
225
fccc685 Initial open-source release
MLstate authored
226 module StringMap =
227 struct
228 let (!!) s = !! ("StringMap_" ^ s)
229 let add = !! "add"
230 let empty = !! "empty"
231 let fold = !! "fold"
232 end
233
51f92b4 [feature] adding: a no_client_calls directive
Hugo Heuzard authored
234 module ThreadContext =
235 struct
236 let (!!) s = !! ("ThreadContext_" ^ s)
237 let no_client_calls = !! "no_client_calls"
238 end
239
fccc685 Initial open-source release
MLstate authored
240 module Xml =
241 struct
eafacd5 @OpaOnWindowsNow [cleanup] opacapi,{list,xhtml}.opa: respect opacapi guidelines
OpaOnWindowsNow authored
242 let (!!) s = !! ("Xml_" ^ s)
fccc685 Initial open-source release
MLstate authored
243 let find_attr = !! "find_attr"
244 let match_number = !! "match_number"
245 let match_plus = !! "match_plus"
246 let match_question = !! "match_question"
247 let match_range = !! "match_range"
248 let match_star = !! "match_star"
249 end
250
251 (**
252 Types definitions
253 *)
254 module Types =
255 struct
256
257 let bool = !! "bool"
258
259 let badop_engine_database_options = !! "badop_engine_database_options"
260 let badoplink_data_d = !! "badoplink_data_d"
261 let badoplink_database = !! "badoplink_database"
262 let badoplink_db_partial_key = !! "badoplink_db_partial_key"
263 let badoplink_db_path_key = !! "badoplink_db_path_key"
264 let badop_engine_t = !! "badop_engine_t"
265 let badoplink_node_config = !! "badoplink_node_config"
266 let badoplink_path = !! "badoplink_path"
267 let badoplink_transaction = !! "badoplink_transaction"
268
269 let binary = !! "binary"
270 let caml_list = !! "caml_list"
271 let char = !! "char"
272 let continuation = !! "continuation"
273 let dbgraph_diff = !! "dbgraph_diff"
274 let dbset = !! "dbset"
275 let dom = !! "dom"
276 let finite_single_thread_lazy = !! "finite_single_thread_lazy"
277 let float = !! "float"
278 let handle_assoc = !! "handle_assoc"
279 let event_handler = !! "event_handler"
280 let int = !! "int"
281 let ip = !! "ip"
282 let itextrator = !! "itextrator"
283 let list = !! "list"
284 let llarray = !! "llarray"
285 let map = !! "map"
286 let option = !! "option"
287
288 let path_embed_info = !! "path_embed_info"
289 let path_embedded_obj = !! "path_embedded_obj"
290 let path_ref_p = !! "path_ref_p"
291 let path_t = !! "path_t"
292 let path_val_p = !! "path_val_p"
293
294 let string = !! "string"
295 let stringmap = !! "stringmap"
296 let text = !! "text"
297
16819fc [enhance] opa/transactions: refactored implem and interface, database tr...
Louis Gesbert authored
298 let transactions_t = !! "opa_transaction_t"
fccc685 Initial open-source release
MLstate authored
299 let tuple_2 = !! "tuple_2"
300 let virtual_ref_path = !! "virtual_ref_path"
301 let virtual_val_path = !! "virtual_val_path"
302
303 let void = !! "void"
304 let xhtml = !! "xhtml"
305 let xhtml_event = !! "xhtml_event"
306 let xhtml_href = !! "xhtml_href"
307 let xml = !! "xml"
308
45d0b17 [enhance] rpc: add timeout feature in calls from server to clients
Mathieu Barbin authored
309 module Cell =
310 struct
311 let (!!) s = !! ("Cell." ^ s)
312 let timeout = !! "timeout"
313 end
314
fccc685 Initial open-source release
MLstate authored
315 module Css =
316 struct
317 let (!!) s= !! ("Css." ^ s)
318 let background = !! "background"
319 let event = !! "event"
320 let length = !! "length"
321 let percentage = !! "percentage"
322 let prop_value_item = !! "prop_value_item"
323 let selector_item = !! "selector_item"
324 let size = !! "size"
325 let size_or_none = !! "size_or_none"
326 let size_or_normal = !! "size_or_normal"
327 end
328
329 module Cps =
330 struct
331 let (!!) s = !! ("Cps." ^ s)
332 let future = !! "future"
333 end
334
335 module Deprecated =
336 struct
337 let (!!) s = !! ("Deprecated." ^ s)
338 let argument = !! "argument"
339 end
340
341 module Dom =
342 struct
343 let (!!) s = !! ("Dom." ^ s)
344 let transformation = !! "transformation"
345 module Event =
346 struct
347 let (!!) s = !! ("event." ^ s)
348 let kind = !! "kind"
349 end
350 module Transformation =
351 struct
352 let (!!) s = !! ("Transformation." ^ s)
353 let subject = !! "subject"
354 end
355 end
356
45d0b17 [enhance] rpc: add timeout feature in calls from server to clients
Mathieu Barbin authored
357 module Exception =
358 struct
359 let (!!) s = !! ("Exception." ^ s)
360 let common = !! "common"
361 end
362
fccc685 Initial open-source release
MLstate authored
363 module FunAction =
364 struct
365 let (!!) s = ("FunAction." ^ s)
366 let t = !! "t"
367 end
368
369 module OPA =
370 struct
371 let (!!) s = !! ("OPA." ^ s)
372 module Init =
373 struct
374 let (!!) s = !! ("Init." ^ s)
375 let value = !! "value"
376 end
377 end
378
379 module OpaRPC =
380 struct
381 let (!!) s = !! ("OpaRPC." ^s)
382 let request = !! "request"
45d0b17 [enhance] rpc: add timeout feature in calls from server to clients
Mathieu Barbin authored
383 let timeout = !! "timeout"
fccc685 Initial open-source release
MLstate authored
384 end
385
386 module OpaSerialize =
387 struct
388 let (!!) s = !! ("OpaSerialize." ^s)
389 let options = !! "options"
390 end
391
392 module OpaTsc =
393 struct
394 let (!!) s = !! ("OpaTsc." ^s)
395 let t = !! "t"
396 end
397
398 module OpaType =
399 struct
400 let (!!) s = !! ("OpaType." ^s)
401 let col = !! "col"
402 let row = !! "row"
403 let ty = !! "ty"
404 let typevar = !! "typevar"
405 end
406
407 module Order =
408 struct
409 let (!!) s = !! ("Order." ^s)
410 let comparison = !! "comparison"
411 end
412
413 module Parser =
414 struct
415 let (!!) s = !! ("Parser." ^ s)
416 let general_parser = !! "general_parser"
417 end
418
419 module RPC =
420 struct
421 let (!!) s = !! ("RPC." ^s)
422 module Json =
423 struct
424 let (!!) s = !! ("Json." ^ s)
425 let json = !! "json"
426 end
427 end
428
429 module ThreadContext =
430 struct
431 let (!!) s = !! ("ThreadContext." ^ s)
432 let t = (!!) "t"
433 end
434
435 module Xml =
436 struct
437 let (!!) s = !! ("Xml." ^ s)
438 let attribute = !! "attribute"
439 end
440
441 end
442
443
444 (**
445 Bypass inserted by the compiler
446 *)
447 module Opabsl =
448 struct
449
450 let table = Hashtbl.create 128
451
452 let (!!) s =
453 let s = BslKey.normalize s in
454 if Hashtbl.mem table s then (prerr_endline (BslKey.to_string s); assert false);
455 Hashtbl.add table s s;
456 s
457
458 module Badoplink =
459 struct
460 let (!!) s = !! ("Badoplink." ^ s)
461 let add_hole = !! "add_hole"
462 let add_key = !! "add_key"
463 let clear = !! "clear"
464 let create_dbset = !! "create_dbset"
465 let data_binary = !! "data_binary"
466 let data_float = !! "data_float"
467 let data_int = !! "data_int"
468 let data_obj_binary = !! "data_obj_binary"
469 let data_obj_float = !! "data_obj_float"
470 let data_obj_int = !! "data_obj_int"
471 let data_obj_text = !! "data_obj_text"
472 let data_text = !! "data_text"
473 let data_unit = !! "data_unit"
474 let db_prefix = !! "db_prefix"
475 let dbpath_add = !! "dbpath_add"
476 let dbpath_root = !! "dbpath_root"
477 let empty_partial_key = !! "empty_partial_key"
478 let error = !! "error"
479 let exists = !! "exists"
480 let fatal_error = !! "fatal_error"
481 let fold_children = !! "fold_children"
482 let fold_int_keys = !! "fold_int_keys"
483 let fold_string_keys = !! "fold_string_keys"
484 let get_new_key = !! "get_new_key"
485 let get_opt = !! "get_opt"
486 let get_registered_db_ident = !! "get_registered_db_ident"
487 let get_registered_root_edge = !! "get_registered_root_edge"
488 let is_db_new = !! "is_db_new"
489 let jlog = !! "jlog"
490 let key_int = !! "key_int"
491 let key_list = !! "key_list"
492 let key_string = !! "key_string"
493 let key_value_int = !! "key_value_int"
494 let key_value_string = !! "key_value_string"
495 let node_config_construct = !! "node_config_construct"
496 let node_properties = !! "node_properties"
497 let open_db = !! "open_db"
498 let register_db_ident = !! "register_db_ident"
499 let register_root_edge = !! "register_root_edge"
500 let remove_children = !! "remove_children"
501 let set = !! "set"
502 let set_current_copy = !! "set_current_copy"
503 let set_dbset_keys = !! "set_dbset_keys"
504 let set_link = !! "set_link"
505 let shall_i_upgrade = !! "shall_i_upgrade"
506 let trans_abort = !! "trans_abort"
507 let trans_commit = !! "trans_commit"
508 let trans_start = !! "trans_start"
509 let uppath = !! "uppath"
510 end
511
512 module BadopEngine =
513 struct
514 let (!!) s = !! ("Badop_engine." ^ s)
515 let check_remaining_arguments = !! "check_remaining_arguments"
516 let local_options = !! "local_options"
f764139 @nrs135 [feature] Badop_light: Attempt at OPA integration (partially successful...
nrs135 authored
517 let light_options = !! "light_options"
fccc685 Initial open-source release
MLstate authored
518 let client_options = !! "client_options"
519 let get = !! "get"
520 end
521
522 module BslClientCode =
523 struct
524 let (!!) s = !! ("BslClientCode." ^ s)
525 let serialize_string_length = !! "serialize_string_length"
526 end
527
528 module BslClosure =
529 struct
530 let (!!) s = !! ("BslClosure." ^ s)
531 let create_and_register = !! "create_and_register"
532 let create_no_function_and_register = !! "create_no_function_and_register"
533 let define_function = !! "define_function"
534 end
535
536 module BslCps =
537 struct
538 let (!!) s = !! ("BslCps." ^ s)
4756eb9 [cleanup] bsl: opacapize cpsRewriter
Raja authored
539 let before_wait = !! "before_wait"
540 let black_make_barrier = !! "black_make_barrier"
541 let black_release_barrier = !! "black_release_barrier"
542 let black_toplevel_wait = !! "black_toplevel_wait"
543 let bt_add = !! "bt_add"
544 let callcc_directive = !! "callcc_directive"
545 let catch = !! "catch"
546 let catch_native = !! "catch_native"
547 let ccont = !! "ccont"
548 let ccont_native = !! "ccont_native"
549 let cont = !! "cont"
550 let cont_native = !! "cont_native"
551 let debug = !! "debug"
552 let fun_args2string = !! "fun_args2string"
553 let handler_cont = !! "handler_cont"
554 let magic_func = !! "magic_func"
555 let make_barrier = !! "make_barrier"
556 let release_barrier = !! "release_barrier"
557 let return = !! "return"
558 let spawn = !! "spawn"
559 let thread_context = !! "thread_context"
560 let toplevel_wait = !! "toplevel_wait"
561 let uncps_native = !! "uncps_native"
562 let wait = !! "wait"
563 let with_thread_context = !! "with_thread_context"
fccc685 Initial open-source release
MLstate authored
564 module Notcps_compatibility =
565 struct
566 let (!!) s = !! ("Notcps_compatibility." ^ s)
567 let thread_context = !! "thread_context"
4756eb9 [cleanup] bsl: opacapize cpsRewriter
Raja authored
568 let dummy_cont = !! "dummy_cont"
09d9c9d @OpaOnWindowsNow [enhance] qmlCpsRewriter: use opacapi in non cps mode
OpaOnWindowsNow authored
569 let max_cps_native = 5
570 (* define an array of !! "cps%d_native" from min_cps_native to max_cps_native *)
571 let cps_native =
572 let cps_native_str arity = Printf.sprintf "cps%d_native" arity in
573 let array = Array.init (max_cps_native+1) (fun i -> !! (cps_native_str i)) in
574 fun arity -> array.(arity)
fccc685 Initial open-source release
MLstate authored
575 end
576 end
577
578 module BslInit =
579 struct
580 let (!!) s = !! ("BslInit." ^ s)
581 let set_executable_id = !! "set_executable_id"
582 end
583
584 module BslJsIdent =
585 struct
586 let (!!) s = !! ("BslJsIdent." ^ s)
587 let define_rename = !! "define_rename"
588 let set_cleaning_default_value = !! "set_cleaning_default_value"
589 end
590
591 module BslNativeLib =
592 struct
593 let (!!) s = !! ("BslNativeLib."^s)
594 let cons = !! "cons"
595 let empty_list = !! "empty_list"
596 end
597
598 module BslPervasives =
599 struct
600 let (!!) s = !! ("BslPervasives." ^ s)
601 let compare_raw = !! "compare_raw"
602 let fail = !! "fail"
603 let fail_cps = !! "fail_cps"
604 let return_exc = !! "return_exc"
605
606 module Magic =
607 struct
608 let (!!) s = !! ("Magic." ^ s)
609 let id = !! "id"
610 end
611 end
612
613 module BslReference =
614 struct
615 let (!!) s = !! ("BslReference." ^ s)
616 let create = !! "create"
617 end
618
619 module BslValue =
620 struct
621 let (!!) s = !! ("BslValue." ^ s)
622 module Tsc =
623 struct
624 let (!!) s = !! ("Tsc." ^ s)
625 let add = !! "add"
626 end
627 end
628
629 module Dbgraph =
630 struct
631 let (!!) s = !! ("Dbgraph." ^ s)
632 let diff = !! "diff"
633 let diff_message = !! "diff_message"
634 let diff_status = !! "diff_status"
635 let empty_diff = !! "empty_diff"
636 let get_diffed_schema = !! "get_diffed_schema"
637 let matching_edge = !! "matching_edge"
638 let print_tree = !! "print_tree"
639 end
640
641 module Path =
642 struct
643 let (!!) s = !! ("Path." ^ s)
644 let copy = !! "copy"
645 let embed_record_data = !! "embed_record_data"
646 let embedded_path = !! "embedded_path"
647 let get_lazy_info_opt = !! "get_lazy_info_opt"
648 let get_ref_path = !! "get_ref_path"
649 let get_val_path = !! "get_val_path"
650 let inject_record_data = !! "inject_record_data"
651 end
652
653 module Transactions =
654 struct
16819fc [enhance] opa/transactions: refactored implem and interface, database tr...
Louis Gesbert authored
655 let (!!) s = !! ("Opa_transaction." ^ s)
fccc685 Initial open-source release
MLstate authored
656 let commit = !! "commit"
657 let continue = !! "continue"
658 let fail = !! "fail"
659 let get_global_transaction_opt = !! "get_global_transaction_opt"
660 let set_global_transaction = !! "set_global_transaction"
661 let start = !! "start"
662 end
663
664 module BslAppSrcCode =
665 struct
666 let (!!) s = !! ("BslAppSrcCode." ^ s)
667 let register_src_code = !! "register_src_code"
668 let register_special_src_code = !! "register_special_src_code"
669 end
670
671 end
Something went wrong with that request. Please try again.