From 6cac80b420858d382199088b56d958d1c1e38d11 Mon Sep 17 00:00:00 2001
From: Pascal Raymond <Pascal.Raymond@imag.fr>
Date: Sat, 14 Jul 2012 18:51:52 +0200
Subject: [PATCH] ...
---
src/getEff.ml | 135 ++++++++++++++++++++++++++------------------------
1 file changed, 70 insertions(+), 65 deletions(-)
diff --git a/src/getEff.ml b/src/getEff.ml
index 18bba04a..cf24dcec 100644
--- a/src/getEff.ml
+++ b/src/getEff.ml
@@ -143,7 +143,11 @@ let rec (of_node : Eff.id_solver -> SyntaxTreeCore.node_exp srcflagged ->
*)
(*
-C'EST ICI QU'IL FAUT TRAITER LES MACROS PREDEF !
+TRAITER LES MACROS PREDEF :
+- ici, on juste besoin de fabriquer les arguments statiques effectifs
+ à partir des arguments donnés et des args attendus.
+- on cherche pas à faire rentrer dans le moule, on délègue
+
*)
let static_args_eff = match static_args with
@@ -169,12 +173,12 @@ C'EST ICI QU'IL FAUT TRAITER LES MACROS PREDEF !
(** [check_static_arg this pn id sa (symbols, acc)] compile a static arg
into a static_arg
*)
-and (check_static_arg : Eff.id_solver ->
- SyntaxTreeCore.static_param srcflagged ->
- SyntaxTreeCore.static_arg srcflagged ->
- Eff.static_arg) =
- fun node_id_solver sp sa ->
-
+and check_static_arg
+ (node_id_solver: Eff.id_solver)
+ (sp: SyntaxTreeCore.static_param srcflagged)
+ (sa: SyntaxTreeCore.static_arg srcflagged)
+: Eff.static_arg =
+(
let rec (eff_type_and_type_exp_are_equal:
Eff.type_ -> SyntaxTreeCore.type_exp_core -> bool) =
fun teff texp ->
@@ -229,73 +233,74 @@ and (check_static_arg : Eff.id_solver ->
else (neff.inlist_eff, neff.outlist_eff)
in
- let sa_eff =
+ (* sa = donné ; sp = attendu *)
+ let sa_eff =
match sa.it, sp.it with
- | StaticArgIdent idref, StaticParamConst(id, type_exp) ->
- let ceff = node_id_solver.id2const idref sa.src in
- let t_ceff = type_of_const ceff in
- check_type_arg t_ceff type_exp;
- ConstStaticArgEff (id, ceff)
-
- | StaticArgIdent idref, StaticParamType(id) ->
- let teff = node_id_solver.id2type idref sa.src in
- TypeStaticArgEff (id, teff)
-
- | StaticArgConst ce, StaticParamConst(id, type_exp) -> (
- let ceff = EvalConst.f node_id_solver ce in
- let t_ceff = type_of_const (List.hd ceff) in
- check_type_arg t_ceff type_exp;
- match ceff with
- | [ceff] -> ConstStaticArgEff (id,ceff)
- | _ -> assert false (* should not occur *)
- )
- | StaticArgType te, StaticParamType id ->
- let teff = of_type node_id_solver te in
- TypeStaticArgEff (id, teff)
-
- | StaticArgIdent idref, StaticParamNode(id, vii, vio,_) ->
- (* idref is an alias, hence it cannot have static argument *)
- let sargs = [] in
- let neff = node_id_solver.id2node idref sargs sa.src in
- (* ICI a revoir ? *)
- (* let (inlist, outlist) = check_node_arg neff vii vio in *)
- let _ = check_node_arg neff vii vio in
- NodeStaticArgEff (id, neff.node_key_eff)
-
- | StaticArgNode(CALL_n ne), StaticParamNode(id,vii,vio,_) ->
- let neff = of_node node_id_solver ne in
- (* ICI a revoir ? *)
- (* let (inlist, outlist) = check_node_arg neff vii vio in *)
- let _ = check_node_arg neff vii vio in
- NodeStaticArgEff (id, neff.node_key_eff)
-
- | StaticArgNode(Predef_n (op,sargs)), StaticParamNode(id,vii,vio,_) ->
- let sargs_eff =
- translate_predef_static_args node_id_solver op.it sargs sa.src
- in
- let opeff = PredefEvalType.make_node_exp_eff node_id_solver None op.it sa.src sargs_eff in
- (* ICI a revoir ? *)
- (* let (inlist, outlist) = check_node_arg opeff vii vio in *)
- let _ = check_node_arg opeff vii vio in
- NodeStaticArgEff (id, opeff.node_key_eff)
+ | StaticArgIdent idref, StaticParamConst(id, type_exp) ->
+ let ceff = node_id_solver.id2const idref sa.src in
+ let t_ceff = type_of_const ceff in
+ check_type_arg t_ceff type_exp;
+ ConstStaticArgEff (id, ceff)
+ | StaticArgIdent idref, StaticParamType(id) ->
+ let teff = node_id_solver.id2type idref sa.src in
+ TypeStaticArgEff (id, teff)
+ | StaticArgConst ce, StaticParamConst(id, type_exp) -> (
+ let ceff = EvalConst.f node_id_solver ce in
+ let t_ceff = type_of_const (List.hd ceff) in
+ check_type_arg t_ceff type_exp;
+ match ceff with
+ | [ceff] -> ConstStaticArgEff (id,ceff)
+ | _ -> assert false (* should not occur *)
+ )
+ | StaticArgType te, StaticParamType id ->
+ let teff = of_type node_id_solver te in
+ TypeStaticArgEff (id, teff)
+ | StaticArgIdent idref, StaticParamNode(id, vii, vio,_) ->
+ (* idref is an alias, hence it cannot have static argument *)
+ let sargs = [] in
+ let neff = node_id_solver.id2node idref sargs sa.src in
+ (* ICI a revoir ? *)
+ (* let (inlist, outlist) = check_node_arg neff vii vio in *)
+ let _ = check_node_arg neff vii vio in
+ NodeStaticArgEff (id, neff.node_key_eff)
+
+
+ | StaticArgNode(CALL_n ne), StaticParamNode(id,vii,vio,_) ->
+ let neff = of_node node_id_solver ne in
+ (* ICI a revoir ? *)
+ (* let (inlist, outlist) = check_node_arg neff vii vio in *)
+ let _ = check_node_arg neff vii vio in
+ NodeStaticArgEff (id, neff.node_key_eff)
+
+
+ | StaticArgNode(Predef_n (op,sargs)), StaticParamNode(id,vii,vio,_) ->
+ let sargs_eff =
+ translate_predef_static_args node_id_solver op.it sargs sa.src
+
+ in
+ let opeff = PredefEvalType.make_node_exp_eff node_id_solver None op.it sa.src sargs_eff in
+ (* ICI a revoir ? *)
+ (* let (inlist, outlist) = check_node_arg opeff vii vio in *)
+ let _ = check_node_arg opeff vii vio in
+ NodeStaticArgEff (id, opeff.node_key_eff)
- | StaticArgNode(
+ | StaticArgNode(
(MERGE_n _|ARRAY_SLICE_n _|ARRAY_ACCES_n _|STRUCT_ACCESS_n _|IDENT_n _
|ARRAY_n|HAT_n|CONCAT_n|WITH_n(_)|TUPLE_n|WHEN_n(_)|CURRENT_n|FBY_n
|ARROW_n|PRE_n)), _ -> assert false
- | StaticArgType _, StaticParamNode(id,_,_,_)
- | StaticArgType _, StaticParamConst(id,_)
+ | StaticArgType _, StaticParamNode(id,_,_,_)
+ | StaticArgType _, StaticParamConst(id,_)
- | StaticArgNode _, StaticParamType(id)
- | StaticArgNode _, StaticParamConst(id,_)
+ | StaticArgNode _, StaticParamType(id)
+ | StaticArgNode _, StaticParamConst(id,_)
- | StaticArgConst _, StaticParamNode(id,_,_,_)
- | StaticArgConst _, StaticParamType(id)
- ->
- assert false (* can it occur actually? Let's wait it occurs...*)
+ | StaticArgConst _, StaticParamNode(id,_,_,_)
+ | StaticArgConst _, StaticParamType(id) ->
+ assert false (* can it occur actually? Let's wait it occurs...*)
in
- sa_eff
+ sa_eff
+)
(******************************************************************************)
--
GitLab