Permalink
Browse files

[fix] compiler, ei, rpc: previous patch are not totally complete we m…

…ust be considers also lifted rpc
  • Loading branch information...
1 parent 698c35e commit 0639a0f988cacbd265f46559aa9a16f23b8bdafa @BourgerieQuentin BourgerieQuentin committed May 24, 2012
Showing with 49 additions and 14 deletions.
  1. +4 −8 opa/opa_InsertRemote.ml
  2. +12 −2 qmlpasses/pass_ExplicitInstantiation.ml
  3. +33 −4 qmlpasses/pass_ExplicitInstantiation.mli
@@ -510,7 +510,7 @@ let check_and_get ?(msg="") ~annotmap ~gamma:_ explicit_map expr =
#<End>;
let ty = QmlAnnotMap.find_ty_label label annotmap in
let tsc = QmlTypes.Scheme.quantify ty in
- expr, ident, ty, tsc, 0, 0, 0, ty, tsc, `one_lambda
+ expr, ident, ty, tsc, 0, 0, 0, ty, tsc, `one_lambda 0
end
| _ -> iv expr "on an non ident expression"
@@ -642,13 +642,9 @@ let generate_skeleton explicit_map ~annotmap ~stdlib_gamma ~gamma ~side expr =
if is_a_function then
let args_ty = list_expr_ty @ list_expr_row @ list_expr_col in
match number_of_lambdas with
- | `one_lambda ->
- let args_ty, list_expr_val =
- match args_ty with
- | [] -> [], list_expr_val
- | _ -> (args_ty @ list_expr_val), []
- in
- full_apply gamma annotmap expr args_ty list_expr_val
+ | `one_lambda env ->
+ let env_args, list_expr_val = List.split_at env list_expr_val in
+ full_apply gamma annotmap expr (args_ty @ env_args) list_expr_val
| `two_lambdas ->
let annotmap, apply1 = QmlAstCons.TypedExpr.apply gamma annotmap expr args_ty in
QmlAstCons.TypedExpr.apply gamma annotmap apply1 list_expr_val
@@ -155,7 +155,7 @@ module Q = QmlAst
(* -- *)
(* Here a reference to published map *)
-type published_map = (Annot.label * Ident.t * [`one_lambda | `two_lambdas]) option IdentMap.t
+type published_map = (Annot.label * Ident.t * [`one_lambda of int | `two_lambdas]) option IdentMap.t
let published_ref = ref (IdentMap.empty : published_map)
(* Same hack as above, but for ei to update the link between current identifiers and the one before slicing *)
let renaming_map = ref QmlRenamingMap.empty
@@ -1064,6 +1064,16 @@ let filter_left f l1 l2 =
| _ -> invalid_arg "filter_left" in
aux [] l1 l2
+let rec get_lifted_env = function
+ | Q.Directive (_, (#Q.type_directive | `abstract_ty_arg _ | `apply_ty_arg _ | `async), [e], _) ->
+ get_lifted_env e
+ | Q.Directive (_, `lifted_lambda env, [e], _) -> (
+ match e with
+ | Q.Lambda (_,_params,_e) -> fst env
+ | _ -> assert false
+ )
+ | _ -> 0
+
let type_of_args_from_quant gamma lt lrow lcol =
let opaty = opaty gamma in
let oparow = oparow gamma in
@@ -1398,7 +1408,7 @@ let process_code (have_typeof:QmlTypeVars.FreeVars.t) gamma annotmap _published
let annotmap, map_e = TypedExpr.ident annotmap id ty in
(* put the ident in the map in any case
* so that InsertRemote knows that it was rewritten *)
- published_ref := IdentMap.add id (Some (Q.Label.expr map_e, id, `one_lambda)) !published_ref;
+ published_ref := IdentMap.add id (Some (Q.Label.expr map_e, id, `one_lambda (get_lifted_env e))) !published_ref;
((annotmap, e), ajax_ast)
) else
let ajax_id = Ident.refresh id in
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -29,10 +29,39 @@
*)
-(* Hack: 2 global refs instead of function arguments; TODO: unhack *)
-(** A map of top-level expressions published between client and server *)
-type published_map = (Annot.label * Ident.t * [`one_lambda | `two_lambdas]) option IdentMap.t
+
+(** A map of top-level expressions published between client and server. This map
+ binds the name of the published function and informations of an
+ 'ei_skeleton' function. This skeleton throws useless type arguments. These
+ informations are the ident of the skeleton and how the skeleton has been
+ generated.
+
+ - [`one_lambda e] means the skeleton is composed by a uniq lambda, i.e. the
+ type and casual arguments are in the same block. [e] is the size of the
+ previous lifted lambda.
+
+ - [`two_lambdas] means the type and casual arguments are in two separated
+ blocks
+
+ Where f and g are published:
+ {[
+ _v0_f = a, b -> @typeof('b)
+ _v0_g = a -> void
+ ]}
+
+ Rewrited as:
+ {[
+
+ _v0_f = @lifted_lambda(1, (vvva, a, b -> vvva))
+ // _v0_f -> (`one_lambda 0 , _v0 -> f)
+
+ _v0_g = a -> void
+ _v1_g = _ -> (a -> void)
+ // _v0_g -> (`two_lambdas, _v1_g)
+ ]}
+*)
+type published_map = (Annot.label * Ident.t * [`one_lambda of int | `two_lambdas]) option IdentMap.t
val published_ref : published_map ref
(** The link between current identifiers and the ones before slicing *)

0 comments on commit 0639a0f

Please sign in to comment.