Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

[revert] bsl: "[cleanup] bsl: unused closure functions"

This reverts commit c5d1e28.
  • Loading branch information...
commit 8cbc586b70088aad84cd809c1f358a1278279549 1 parent fc7bd63
Anthonin Bonnefoy authored
Showing with 78 additions and 0 deletions.
  1. +30 −0 opabsl/jsbsl/bslClosure.js
  2. +48 −0 opabsl/mlbsl/bslClosure.ml
View
30 opabsl/jsbsl/bslClosure.js
@@ -83,6 +83,19 @@ function get_local_unsafe(str) {
return function() { return f.call(null,arguments) }
}
+##register [cps-bypass] create_anyarray_cps \ `create_anyarray_cps` : 'impl, int, 'ident, continuation(Closure.t) -> void
+function create_anyarray_cps(f,n,identifier,k)
+{
+ /*
+ var any_cps = function(args){
+ var k = args.pop();
+ return f(args, k);
+ }
+ return %BslClosure.create%(any_cps, n+1, identifier);
+ */
+ error("TODO create_any_array_cps")
+}
+
/**
* Part of JsInterface (funaction)
**/
@@ -91,6 +104,15 @@ function args_apply(closure,args) {
}
##register apply \ `args_apply` : Closure.t, Closure.args -> 'a
+##register [cps-bypass] apply_cps : Closure.t, Closure.args, continuation('a) -> void
+##args(closure, args, k)
+{
+ error("TODO: apply_cps")
+ /*if(closure.arity - 1 == args.length + closure.args.length){
+ args.push(k);
+ }
+ return %BslClosure.apply%(closure, args);*/
+}
function get_closure_name(closure) {
return closure.toString().match(/function *([^(]*)/)[1]
@@ -116,6 +138,14 @@ function get_closure_name(closure) {
return (global[name] == closure) // toplevel function are the only opa closures that are empty
}
+##register import \ `clos_import` : 'a, int -> Closure.t
##register export \ `clos_export` : Closure.t -> 'a
function clos_import(clos,_arity) { return clos }
function clos_export(clos) { return clos }
+
+/** Should print closure-related info. Ignored for the moment.*/
+##register closure_debug_from_opa: string,string -> void
+##args(topic, message)
+{
+ return ;
+}
View
48 opabsl/mlbsl/bslClosure.ml
@@ -34,6 +34,7 @@
##register get_identifier \ `QmlClosureRuntime.get_identifier` : 'closure -> option('a)
##register set_identifier \ `QmlClosureRuntime.set_identifier` : Closure.t, 'a -> void
##register export \ `QmlClosureRuntime.export` : Closure.t -> 'a
+##register import \ `QmlClosureRuntime.import` : 'a, int -> Closure.t
(** Create an "anyarray" closure. These closures consider that the
given native implementation is a function that takes an anyarray
@@ -42,6 +43,53 @@
*)
##register create_anyarray \ `QmlClosureRuntime.create_anyarray` : 'impl, int, 'ident -> Closure.t
+(** Create an "anyarray" closure with cps code transformation.
+ i.e. We suppose that the given impl is a native function
+ typed by [Closure.args -> 'a cont -> unit].
+ see also [opavalue.opa (OpaValue.Closure)]
+*)
+##register [cps-bypass] create_anyarray_cps : 'impl, int, 'ident, continuation(Closure.t) -> void
+let create_anyarray_cps func arity ident k =
+ let any_cps oargs =
+ let args = QmlClosureRuntime.AnyArray.sub2 oargs 0 arity in
+ let k = QmlClosureRuntime.AnyArray.get oargs arity in
+ ((Obj.magic func) : _ (*args*) -> _ (*cont*) -> _) args k
+ in
+ (* arity+1 for continuation added by cps *)
+ let cl = QmlClosureRuntime.create_anyarray any_cps (arity + 1) ident in
+ QmlCpsServerLib.return k cl
+
+##register [cps-bypass] apply_cps : Closure.t, Closure.args, continuation('a) -> void
+let apply_cps closure args k =
+ (* Add k only on full application *)
+ assert (
+ if (
+ closure.QmlClosureRuntime.arity - 1 =
+ (QmlClosureRuntime.AnyArray.length closure.QmlClosureRuntime.args)
+ + (QmlClosureRuntime.AnyArray.length args)
+ ) then true else (
+ Printf.printf "BslClosure.apply_cps:\n closure:%s\n args:%s\n k:%s\n"
+ (DebugPrint.print closure)
+ (DebugPrint.print args)
+ (DebugPrint.print k);
+ false
+ )
+ );
+ let args = QmlClosureRuntime.AnyArray.append args [|Obj.repr k|] in
+ QmlClosureRuntime.args_apply closure args
+
+
+(** A function used to print closure-related debug info*)
+##register closure_debug_from_opa: string, string -> void
+let closure_debug_from_opa __topic __msg =
+ #<If:CLOSURE_DEBUG>
+ Logger.debug "[CLOSURE][%s] %s %!" __topic __msg
+ #<Else>
+ ()
+ #<End>
+
+
+
(* CLOSURE REGISTERING *)
(** Type of the information. *)
type t = {
Please sign in to comment.
Something went wrong with that request. Please try again.