Browse files

[fix] build: plugins compilation (opabsl)

  • Loading branch information...
1 parent d4399c2 commit b8c8e35f3f93e489428e2dabfaf1c9c038290d42 @BourgerieQuentin BourgerieQuentin committed Aug 6, 2012
View
198 lib/plugins/opabsl/mlbsl/bslNativeLib.ml
@@ -28,18 +28,7 @@
{1 Option}
*)
-##opa-type option('a)
-
-let wrap_option proj = function
- | Some a -> wrap_opa_option (ServerLib.some (proj a))
- | None -> wrap_opa_option ServerLib.none
-
-let unwrap_option proj opa =
- let record = unwrap_opa_option opa in
- let opt = ServerLib.unwrap_option record in
- match opt with
- | None -> opt
- | Some v -> Some (proj v)
+include BslUtils
(**
{1 Lists}
@@ -48,7 +37,7 @@ let unwrap_option proj opa =
(**
Type [list('a)], as known by OPA
*)
-##opa-type list('a)
+
(**
Type ['a list], as known by OCaml
@@ -70,200 +59,27 @@ let unwrap_option proj opa =
##register tl : caml_list('a) -> option(caml_list('a))
let tl = function |_::y -> Some y | _ -> None
-##register caml_list_to_opa_list: ('a -> 'b), caml_list('a) -> opa[list('b)]
- let field_nil = ServerLib.static_field_of_name "nil"
- let field_hd = ServerLib.static_field_of_name "hd"
- let field_tl = ServerLib.static_field_of_name "tl"
- let caml_list_to_opa_list converter l =
- let empty = ServerLib.make_simple_record field_nil in
- let rcons tl hd =
- let cons = ServerLib.empty_record_constructor in
- let cons = ServerLib.add_field cons field_hd (converter hd) in
- let cons = ServerLib.add_field cons field_tl tl in
- ServerLib.make_record cons
- in
- wrap_opa_list (List.fold_left rcons empty (List.rev l))
+##register caml_list_to_opa_list : ('a -> 'b), caml_list('a) -> opa[list('b)]
- ##register opa_list_to_ocaml_list: ('a -> 'b), opa[list('a)] -> caml_list('b)
- let opa_list_to_ocaml_list f l =
- let r = unwrap_opa_list l in
- let rec aux(r,acc) =
- match ServerLib.dot r field_hd with
- | None -> List.rev acc
- | Some a ->
- let tl = ServerLib.unsafe_dot r field_tl in
- aux(tl,(f a)::acc)
- in aux(r,[])
+##register opa_list_to_ocaml_list : ('a -> 'b), opa[list('a)] -> caml_list('b)
(**
{1 Tuples}
*)
-(**
- caml_tuple_* as known by OCaml
-*)
-##property[mli]
-##extern-type caml_tuple_2('a,'b) = ('a*'b)
-##extern-type caml_tuple_3('a,'b,'c) = ('a*'b*'c)
-##extern-type caml_tuple_4('a,'b,'c,'d) = ('a*'b*'c*'d)
-##extern-type caml_tuple_5('a,'b,'c,'d,'e) = ('a*'b*'c*'d*'e)
-##property[endmli]
-
-(**
- tuple_* as known by OPA
-*)
-##opa-type tuple_2('a,'b)
-##opa-type tuple_3('a,'b,'c)
-##opa-type tuple_4('a,'b,'c,'d)
-##opa-type tuple_5('a,'b,'c,'d,'e)
-
-let f1 = ServerLib.static_field_of_name "f1"
-let f2 = ServerLib.static_field_of_name "f2"
-let f3 = ServerLib.static_field_of_name "f3"
-let f4 = ServerLib.static_field_of_name "f4"
-let f5 = ServerLib.static_field_of_name "f5"
-
-
-
##register ocaml_tuple_2 : opa[tuple_2('a,'b)] -> caml_tuple_2('a,'b)
-let ocaml_tuple_2 opa =
- let record = unwrap_opa_tuple_2 opa in
- let a = ServerLib.unsafe_dot record f1 in
- let b = ServerLib.unsafe_dot record f2 in
- (a, b)
-
-let opa_tuple_2 (a, b) =
- let record =
- let acc = ServerLib.empty_record_constructor in
- let acc = ServerLib.add_field acc f1 a in
- let acc = ServerLib.add_field acc f2 b in
- ServerLib.make_record acc
- in
- wrap_opa_tuple_2 record
-
-let ocaml_tuple_3 opa =
- let record = unwrap_opa_tuple_3 opa in
- let a = ServerLib.unsafe_dot record f1 in
- let b = ServerLib.unsafe_dot record f2 in
- let c = ServerLib.unsafe_dot record f3 in
- (a, b, c)
-
-let opa_tuple_3 (a, b, c) =
- let record =
- let acc = ServerLib.empty_record_constructor in
- let acc = ServerLib.add_field acc f1 a in
- let acc = ServerLib.add_field acc f2 b in
- let acc = ServerLib.add_field acc f3 c in
- ServerLib.make_record acc
- in
- wrap_opa_tuple_3 record
##register ocaml_tuple_4 : opa[tuple_4('a,'b,'c,'d)] -> caml_tuple_4('a,'b,'c,'d)
-let ocaml_tuple_4 opa =
- let record = unwrap_opa_tuple_4 opa in
- let a = ServerLib.unsafe_dot record f1 in
- let b = ServerLib.unsafe_dot record f2 in
- let c = ServerLib.unsafe_dot record f3 in
- let d = ServerLib.unsafe_dot record f4 in
- (a, b, c, d)
-
-let opa_tuple_4 (a, b, c, d) =
- let record =
- let acc = ServerLib.empty_record_constructor in
- let acc = ServerLib.add_field acc f1 a in
- let acc = ServerLib.add_field acc f2 b in
- let acc = ServerLib.add_field acc f3 c in
- let acc = ServerLib.add_field acc f4 d in
- ServerLib.make_record acc
- in
- wrap_opa_tuple_4 record
##register ocaml_tuple_5 : opa[tuple_5('a,'b,'c,'d,'e)] -> caml_tuple_5('a,'b,'c,'d,'e)
-let ocaml_tuple_5 opa =
- let record = unwrap_opa_tuple_5 opa in
- let a = ServerLib.unsafe_dot record f1 in
- let b = ServerLib.unsafe_dot record f2 in
- let c = ServerLib.unsafe_dot record f3 in
- let d = ServerLib.unsafe_dot record f4 in
- let e = ServerLib.unsafe_dot record f5 in
- (a, b, c, d, e)
-
-let opa_tuple_5 (a, b, c, d, e) =
- let record =
- let acc = ServerLib.empty_record_constructor in
- let acc = ServerLib.add_field acc f1 a in
- let acc = ServerLib.add_field acc f2 b in
- let acc = ServerLib.add_field acc f3 c in
- let acc = ServerLib.add_field acc f4 d in
- let acc = ServerLib.add_field acc f5 e in
- ServerLib.make_record acc
- in
- wrap_opa_tuple_5 record
-
(**
{1 Continuations}
*)
+
+##property[mli]
##extern-type continuation('a) = 'a QmlCpsServerLib.continuation
+##property[end_mli]
(**
{1 Standard Exceptions}
*)
-
-##opa-type exception
-##opa-type exception_common
-
-module OpaExc =
-struct
- (**
- Keep synchronized with stdlib.core/exception.opa
- *)
-
- let f_fail = ServerLib.static_field_of_name "fail"
- let f_position = ServerLib.static_field_of_name "position"
- let fail ~message ~position =
- let r = ServerLib.empty_record_constructor in
- let r = ServerLib.add_field r f_fail (ServerLib.wrap_string message) in
- let r = ServerLib.add_field r f_position (ServerLib.wrap_string position) in
- wrap_opa_exception (ServerLib.make_record r)
-
- let f_transaction_failure = ServerLib.static_field_of_name "Transaction_failure"
- let transaction_failure = ServerLib.make_simple_record f_transaction_failure
-
- let f_ocaml_exc = ServerLib.static_field_of_name "ocaml_exc"
- let f_bslkey = ServerLib.static_field_of_name "bslkey"
- let ocaml_exc bslkey exc =
- let message = Printexc.to_string exc in
- let r = ServerLib.empty_record_constructor in
- let r = ServerLib.add_field r f_ocaml_exc (ServerLib.wrap_string message) in
- let r = ServerLib.add_field r f_bslkey (ServerLib.wrap_string bslkey) in
- wrap_opa_exception (ServerLib.make_record r)
-
-
- (**
- Keep synchronized with stdlib.core.rpc.core/oparpc.opa
- *)
- let f_OpaRPC_Server = ServerLib.static_field_of_name "OpaRPC_Server"
- let f_timeout = ServerLib.static_field_of_name "timeout"
- let f_client = ServerLib.static_field_of_name "client"
- let f_fun_id = ServerLib.static_field_of_name "fun_id"
-
- module OpaRPC =
- struct
- (*
- client : Client.key from BslRPC
- fun_id : the name of the distant function
- *)
- let timeout client fun_id =
- let timeout = ServerLib.empty_record_constructor in
- let timeout = ServerLib.add_field timeout f_client client in
- let timeout =
- ServerLib.add_field timeout f_fun_id (ServerLib.wrap_string fun_id) in
- let timeout = ServerLib.make_record timeout in
- let rpc = ServerLib.empty_record_constructor in
- let rpc = ServerLib.add_field rpc f_timeout timeout in
- let rpc = ServerLib.make_record rpc in
- let exc = ServerLib.empty_record_constructor in
- let exc = ServerLib.add_field exc f_OpaRPC_Server rpc in
- ServerLib.make_record exc
- end
-end
View
7 lib/plugins/opabsl/mlbsl/bslPervasivesServer.ml
@@ -13,4 +13,9 @@
##register flush_all : -> void
let flush_all () = Pervasives.flush_all ()
-##register bin_of_base64 \ `BaseString.base64decode` : string -> binary
+##register bin_of_base64 : string -> binary
+let bin_of_base64 s =
+ let s = BaseString.base64decode s in
+ let b = Buffer.create (String.length s) in
+ Buffer.add_string b s;
+ b
View
8 lib/plugins/opabsl/mlbsl/bslReference.ml
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of Opa.
@@ -10,10 +10,10 @@
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*)
type black_ref (*internal type*)
- external black : 'a ref -> black_ref = "%identity"
- external unblack : black_ref -> 'a ref = "%identity"
+ external black : 'a ref -> 'a ref = "%identity"
+ external unblack : 'a ref -> 'a ref = "%identity"
- ##extern-type reference('a) = black_ref
+ ##extern-type reference('a) = 'a ref
##register [opacapi] create : 'a -> reference('a)
let create x = black (ref x)
View
198 lib/plugins/opabsl/mlbsl/bslUtils.ml
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of Opa.
@@ -46,6 +46,32 @@ let rfree = ServerLib.make_record (ServerLib.add_field ServerLib.empty_record_co
##opa-type outcome('a, 'b)
+##opa-type option('a)
+
+##opa-type list('a)
+
+(**
+ caml_tuple_* as known by OCaml
+*)
+##property[mli]
+##extern-type caml_tuple_2('a,'b) = ('a*'b)
+##extern-type caml_tuple_3('a,'b,'c) = ('a*'b*'c)
+##extern-type caml_tuple_4('a,'b,'c,'d) = ('a*'b*'c*'d)
+##extern-type caml_tuple_5('a,'b,'c,'d,'e) = ('a*'b*'c*'d*'e)
+##property[endmli]
+
+(**
+ tuple_* as known by OPA
+*)
+##opa-type tuple_2('a,'b)
+##opa-type tuple_3('a,'b,'c)
+##opa-type tuple_4('a,'b,'c,'d)
+##opa-type tuple_5('a,'b,'c,'d,'e)
+
+##opa-type exception
+##opa-type exception_common
+
+
(** Project an ['a -> void] opa function rewrited by cps to an ['a ->
unit] ml function, usefull for [cps-bypass].
@@ -104,3 +130,173 @@ let create_outcome = function
(ServerLib.make_record
(ServerLib.add_field ServerLib.empty_record_constructor
ffailure failure))
+
+let wrap_option proj = function
+ | Some a -> wrap_opa_option (ServerLib.some (proj a))
+ | None -> wrap_opa_option ServerLib.none
+
+let unwrap_option proj opa =
+ let record = unwrap_opa_option opa in
+ let opt = ServerLib.unwrap_option record in
+ match opt with
+ | None -> opt
+ | Some v -> Some (proj v)
+
+
+let field_nil = ServerLib.static_field_of_name "nil"
+let field_hd = ServerLib.static_field_of_name "hd"
+let field_tl = ServerLib.static_field_of_name "tl"
+let caml_list_to_opa_list converter l =
+ let empty = ServerLib.make_simple_record field_nil in
+ let rcons tl hd =
+ let cons = ServerLib.empty_record_constructor in
+ let cons = ServerLib.add_field cons field_hd (converter hd) in
+ let cons = ServerLib.add_field cons field_tl tl in
+ ServerLib.make_record cons
+ in
+ wrap_opa_list (List.fold_left rcons empty (List.rev l))
+
+
+let opa_list_to_ocaml_list f l =
+ let r = unwrap_opa_list l in
+ let rec aux(r,acc) =
+ match ServerLib.dot r field_hd with
+ | None -> List.rev acc
+ | Some a ->
+ let tl = ServerLib.unsafe_dot r field_tl in
+ aux(tl,(f a)::acc)
+ in aux(r,[])
+
+let f1 = ServerLib.static_field_of_name "f1"
+let f2 = ServerLib.static_field_of_name "f2"
+let f3 = ServerLib.static_field_of_name "f3"
+let f4 = ServerLib.static_field_of_name "f4"
+let f5 = ServerLib.static_field_of_name "f5"
+
+let ocaml_tuple_2 opa =
+ let record = unwrap_opa_tuple_2 opa in
+ let a = ServerLib.unsafe_dot record f1 in
+ let b = ServerLib.unsafe_dot record f2 in
+ (a, b)
+
+let opa_tuple_2 (a, b) =
+ let record =
+ let acc = ServerLib.empty_record_constructor in
+ let acc = ServerLib.add_field acc f1 a in
+ let acc = ServerLib.add_field acc f2 b in
+ ServerLib.make_record acc
+ in
+ wrap_opa_tuple_2 record
+
+let ocaml_tuple_3 opa =
+ let record = unwrap_opa_tuple_3 opa in
+ let a = ServerLib.unsafe_dot record f1 in
+ let b = ServerLib.unsafe_dot record f2 in
+ let c = ServerLib.unsafe_dot record f3 in
+ (a, b, c)
+
+let opa_tuple_3 (a, b, c) =
+ let record =
+ let acc = ServerLib.empty_record_constructor in
+ let acc = ServerLib.add_field acc f1 a in
+ let acc = ServerLib.add_field acc f2 b in
+ let acc = ServerLib.add_field acc f3 c in
+ ServerLib.make_record acc
+ in
+ wrap_opa_tuple_3 record
+
+let ocaml_tuple_4 opa =
+ let record = unwrap_opa_tuple_4 opa in
+ let a = ServerLib.unsafe_dot record f1 in
+ let b = ServerLib.unsafe_dot record f2 in
+ let c = ServerLib.unsafe_dot record f3 in
+ let d = ServerLib.unsafe_dot record f4 in
+ (a, b, c, d)
+
+let opa_tuple_4 (a, b, c, d) =
+ let record =
+ let acc = ServerLib.empty_record_constructor in
+ let acc = ServerLib.add_field acc f1 a in
+ let acc = ServerLib.add_field acc f2 b in
+ let acc = ServerLib.add_field acc f3 c in
+ let acc = ServerLib.add_field acc f4 d in
+ ServerLib.make_record acc
+ in
+ wrap_opa_tuple_4 record
+
+let ocaml_tuple_5 opa =
+ let record = unwrap_opa_tuple_5 opa in
+ let a = ServerLib.unsafe_dot record f1 in
+ let b = ServerLib.unsafe_dot record f2 in
+ let c = ServerLib.unsafe_dot record f3 in
+ let d = ServerLib.unsafe_dot record f4 in
+ let e = ServerLib.unsafe_dot record f5 in
+ (a, b, c, d, e)
+
+let opa_tuple_5 (a, b, c, d, e) =
+ let record =
+ let acc = ServerLib.empty_record_constructor in
+ let acc = ServerLib.add_field acc f1 a in
+ let acc = ServerLib.add_field acc f2 b in
+ let acc = ServerLib.add_field acc f3 c in
+ let acc = ServerLib.add_field acc f4 d in
+ let acc = ServerLib.add_field acc f5 e in
+ ServerLib.make_record acc
+ in
+ wrap_opa_tuple_5 record
+
+module OpaExc =
+struct
+ (**
+ Keep synchronized with stdlib.core/exception.opa
+ *)
+
+ let f_fail = ServerLib.static_field_of_name "fail"
+ let f_position = ServerLib.static_field_of_name "position"
+ let fail ~message ~position =
+ let r = ServerLib.empty_record_constructor in
+ let r = ServerLib.add_field r f_fail (ServerLib.wrap_string message) in
+ let r = ServerLib.add_field r f_position (ServerLib.wrap_string position) in
+ wrap_opa_exception (ServerLib.make_record r)
+
+ let f_transaction_failure = ServerLib.static_field_of_name "Transaction_failure"
+ let transaction_failure = ServerLib.make_simple_record f_transaction_failure
+
+ let f_ocaml_exc = ServerLib.static_field_of_name "ocaml_exc"
+ let f_bslkey = ServerLib.static_field_of_name "bslkey"
+ let ocaml_exc bslkey exc =
+ let message = Printexc.to_string exc in
+ let r = ServerLib.empty_record_constructor in
+ let r = ServerLib.add_field r f_ocaml_exc (ServerLib.wrap_string message) in
+ let r = ServerLib.add_field r f_bslkey (ServerLib.wrap_string bslkey) in
+ wrap_opa_exception (ServerLib.make_record r)
+
+
+ (**
+ Keep synchronized with stdlib.core.rpc.core/oparpc.opa
+ *)
+ let f_OpaRPC_Server = ServerLib.static_field_of_name "OpaRPC_Server"
+ let f_timeout = ServerLib.static_field_of_name "timeout"
+ let f_client = ServerLib.static_field_of_name "client"
+ let f_fun_id = ServerLib.static_field_of_name "fun_id"
+
+ module OpaRPC =
+ struct
+ (*
+ client : Client.key from BslRPC
+ fun_id : the name of the distant function
+ *)
+ let timeout client fun_id =
+ let timeout = ServerLib.empty_record_constructor in
+ let timeout = ServerLib.add_field timeout f_client client in
+ let timeout =
+ ServerLib.add_field timeout f_fun_id (ServerLib.wrap_string fun_id) in
+ let timeout = ServerLib.make_record timeout in
+ let rpc = ServerLib.empty_record_constructor in
+ let rpc = ServerLib.add_field rpc f_timeout timeout in
+ let rpc = ServerLib.make_record rpc in
+ let exc = ServerLib.empty_record_constructor in
+ let exc = ServerLib.add_field exc f_OpaRPC_Server rpc in
+ ServerLib.make_record exc
+ end
+end
View
2 lib/plugins/opabsl/opabsl.opa_plugin
@@ -48,8 +48,8 @@ nodejsbsl/bslLogger.nodejs
nodejsbsl/bslTimeServer.nodejs
nodejsbsl/bslPervasivesServer.nodejs
-mlbsl/bslNativeLib.ml
mlbsl/bslUtils.ml
+mlbsl/bslNativeLib.ml
mlbsl/bslPervasives.ml
mlbsl/bslBuffer.ml
mlbsl/bslCactutf.ml

0 comments on commit b8c8e35

Please sign in to comment.