From 8a78bc7d7d3cde82eee805fe0bd06673178dbb6c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9onard=20G=C3=A9rard?= Date: Tue, 21 Feb 2012 16:07:29 +0100 Subject: [PATCH] Add [external] in the signatures. fix callgraph acordingly. --- compiler/global/signature.ml | 6 +- compiler/heptagon/hept_utils.ml | 4 +- compiler/heptagon/heptagon.ml | 1 + compiler/heptagon/parsing/hept_lexer.mll | 1 + compiler/heptagon/parsing/hept_parser.mly | 9 ++- compiler/heptagon/parsing/hept_parsetree.ml | 15 ++--- compiler/heptagon/parsing/hept_scoping.ml | 7 ++- compiler/main/hept2mls.ml | 1 + compiler/minils/minils.ml | 1 + compiler/minils/mls_utils.ml | 1 + compiler/minils/transformations/callgraph.ml | 9 +-- lib/iostream.epi | 4 +- lib/pervasives.epi | 66 ++++++++++---------- 13 files changed, 71 insertions(+), 54 deletions(-) diff --git a/compiler/global/signature.ml b/compiler/global/signature.ml index 88cf41b..e0cac69 100644 --- a/compiler/global/signature.ml +++ b/compiler/global/signature.ml @@ -14,7 +14,7 @@ open Linearity (** Warning: Whenever these types are modified, interface_format_version should be incremented. *) -let interface_format_version = "30" +let interface_format_version = "4" type ck = | Cbase @@ -42,6 +42,7 @@ type node = { node_unsafe : bool; node_params : param list; node_param_constraints : constrnt list; + node_external : bool; node_loc : location} type field = { f_name : field_name; f_type : ty } @@ -84,13 +85,14 @@ let mk_field n ty = { f_name = n; f_type = ty } let mk_const_def ty value = { c_type = ty; c_value = value } -let mk_node ?(constraints = []) loc ins outs stateful unsafe params = +let mk_node ?(constraints = []) loc ~extern ins outs stateful unsafe params = { node_inputs = ins; node_outputs = outs; node_stateful = stateful; node_unsafe = unsafe; node_params = params; node_param_constraints = constraints; + node_external = extern; node_loc = loc} let rec field_assoc f = function diff --git a/compiler/heptagon/hept_utils.ml b/compiler/heptagon/hept_utils.ml index c1308de..7fb84aa 100644 --- a/compiler/heptagon/hept_utils.ml +++ b/compiler/heptagon/hept_utils.ml @@ -63,13 +63,14 @@ let mk_simple_equation pat e = let mk_switch_equation e l = mk_equation (Eswitch (e, l)) -let mk_signature name ins outs stateful params constraints loc = +let mk_signature name ~extern ins outs stateful params constraints loc = { sig_name = name; sig_inputs = ins; sig_stateful = stateful; sig_outputs = outs; sig_params = params; sig_param_constraints = constraints; + sig_external = extern; sig_loc = loc } let mk_node @@ -116,5 +117,6 @@ let signature_of_node n = node_unsafe = n.n_unsafe; node_params = n.n_params; node_param_constraints = n.n_param_constraints; + node_external = false; node_loc = n.n_loc } diff --git a/compiler/heptagon/heptagon.ml b/compiler/heptagon/heptagon.ml index 2df60c4..4d003be 100644 --- a/compiler/heptagon/heptagon.ml +++ b/compiler/heptagon/heptagon.ml @@ -183,6 +183,7 @@ type signature = { sig_outputs : arg list; sig_params : param list; sig_param_constraints : constrnt list; + sig_external : bool; sig_loc : location } type interface = diff --git a/compiler/heptagon/parsing/hept_lexer.mll b/compiler/heptagon/parsing/hept_lexer.mll index 0a87c5f..653df85 100644 --- a/compiler/heptagon/parsing/hept_lexer.mll +++ b/compiler/heptagon/parsing/hept_lexer.mll @@ -69,6 +69,7 @@ List.iter (fun (str,tok) -> Hashtbl.add keyword_table str tok) [ "split", SPLIT; "reinit", REINIT; "unsafe", UNSAFE; + "external", EXTERNAL; "quo", INFIX3("quo"); "mod", INFIX3("mod"); "land", INFIX3("land"); diff --git a/compiler/heptagon/parsing/hept_parser.mly b/compiler/heptagon/parsing/hept_parser.mly index f30106e..04528d7 100644 --- a/compiler/heptagon/parsing/hept_parser.mly +++ b/compiler/heptagon/parsing/hept_parser.mly @@ -19,7 +19,7 @@ open Hept_parsetree %token BOOL %token STRING %token PRAGMA -%token TYPE FUN NODE RETURNS VAR VAL OPEN END CONST UNSAFE +%token TYPE FUN NODE RETURNS VAR VAL OPEN END CONST UNSAFE EXTERNAL %token FBY PRE SWITCH EVERY %token OR STAR NOT %token AMPERSAND @@ -663,10 +663,14 @@ unsafe: | UNSAFE { true } | /*empty*/ { false } +extern: + | EXTERNAL { true } + | /*empty*/ { false } + interface_desc: | type_dec { Itypedef $1 } | const_dec { Iconstdef $1 } - | u=unsafe VAL n=node_or_fun f=ident pc=node_params LPAREN i=params_signature RPAREN + | e=extern u=unsafe VAL n=node_or_fun f=ident pc=node_params LPAREN i=params_signature RPAREN returns LPAREN o=params_signature RPAREN { Isignature({ sig_name = f; sig_inputs = i; @@ -675,6 +679,7 @@ interface_desc: sig_outputs = o; sig_params = fst pc; sig_param_constraints = snd pc; + sig_external = e; sig_loc = (Loc($startpos,$endpos)) }) } ; diff --git a/compiler/heptagon/parsing/hept_parsetree.ml b/compiler/heptagon/parsing/hept_parsetree.ml index fd4d0f8..179c249 100644 --- a/compiler/heptagon/parsing/hept_parsetree.ml +++ b/compiler/heptagon/parsing/hept_parsetree.ml @@ -212,14 +212,15 @@ type arg = a_name : var_name option } type signature = - { sig_name : dec_name; - sig_inputs : arg list; - sig_stateful : bool; - sig_unsafe : bool; - sig_outputs : arg list; - sig_params : var_dec list; + { sig_name : dec_name; + sig_inputs : arg list; + sig_stateful : bool; + sig_unsafe : bool; + sig_outputs : arg list; + sig_params : var_dec list; sig_param_constraints : exp list; - sig_loc : location } + sig_external : bool; + sig_loc : location } type interface = { i_modname : dec_name; diff --git a/compiler/heptagon/parsing/hept_scoping.ml b/compiler/heptagon/parsing/hept_scoping.ml index f903b92..0c81ca9 100644 --- a/compiler/heptagon/parsing/hept_scoping.ml +++ b/compiler/heptagon/parsing/hept_scoping.ml @@ -171,13 +171,14 @@ let mk_app ?(params=[]) ?(unsafe=false) ?(inlined = false) op = Heptagon.a_unsafe = unsafe; Heptagon.a_inlined = inlined } -let mk_signature name ins outs stateful params constraints loc = +let mk_signature name ~extern ins outs stateful params constraints loc = { Heptagon.sig_name = name; Heptagon.sig_inputs = ins; Heptagon.sig_stateful = stateful; Heptagon.sig_outputs = outs; Heptagon.sig_params = params; Heptagon.sig_param_constraints = constraints; + Heptagon.sig_external = extern; Heptagon.sig_loc = loc } @@ -547,10 +548,10 @@ let translate_signature s = let o = List.map translate_arg s.sig_outputs in let p, _ = params_of_var_decs Rename.empty s.sig_params in let c = List.map translate_constrnt s.sig_param_constraints in - let sig_node = Signature.mk_node s.sig_loc i o s.sig_stateful s.sig_unsafe p in + let sig_node = Signature.mk_node ~extern:s.sig_external s.sig_loc i o s.sig_stateful s.sig_unsafe p in Check_signature.check_signature sig_node; safe_add s.sig_loc add_value n sig_node; - mk_signature n i o s.sig_stateful p c s.sig_loc + mk_signature n i o s.sig_stateful p c s.sig_loc ~extern:s.sig_external let translate_interface_desc = function diff --git a/compiler/main/hept2mls.ml b/compiler/main/hept2mls.ml index 00ef473..a7e23c9 100644 --- a/compiler/main/hept2mls.ml +++ b/compiler/main/hept2mls.ml @@ -239,6 +239,7 @@ let signature s = sig_outputs = s.Heptagon.sig_outputs; sig_params = s.Heptagon.sig_params; sig_param_constraints = s.Heptagon.sig_param_constraints; + sig_external = s.Heptagon.sig_external; sig_loc = s.Heptagon.sig_loc } let interface i = diff --git a/compiler/minils/minils.ml b/compiler/minils/minils.ml index 3b405bb..11e057a 100644 --- a/compiler/minils/minils.ml +++ b/compiler/minils/minils.ml @@ -166,6 +166,7 @@ type signature = { sig_outputs : arg list; sig_params : param list; sig_param_constraints : constrnt list; + sig_external : bool; sig_loc : location } type interface = diff --git a/compiler/minils/mls_utils.ml b/compiler/minils/mls_utils.ml index 0d14152..3297f06 100644 --- a/compiler/minils/mls_utils.ml +++ b/compiler/minils/mls_utils.ml @@ -266,4 +266,5 @@ let signature_of_node n = node_unsafe = n.n_unsafe; node_params = n.n_params; node_param_constraints = n.n_param_constraints; + node_external = false; node_loc = n.n_loc } diff --git a/compiler/minils/transformations/callgraph.ml b/compiler/minils/transformations/callgraph.ml index 2299b7a..125f5ce 100644 --- a/compiler/minils/transformations/callgraph.ml +++ b/compiler/minils/transformations/callgraph.ml @@ -268,13 +268,14 @@ let node_by_longname node = (** @return the list of nodes called by the node named [ln], with the corresponding params (static parameters appear as free variables). *) let collect_node_calls ln = + (** only add nodes when not external and with params *) let add_called_node ln params acc = match params with | [] -> acc | _ -> - (match ln with - | { qual = Pervasives } -> acc - | _ -> (ln, params)::acc) + if (Modules.find_value ln).node_external + then acc + else (ln, params)::acc in let edesc _ acc ed = match ed with | Eapp ({ a_op = (Enode ln | Efun ln); a_params = params }, _, _) -> @@ -287,7 +288,7 @@ let collect_node_calls ln = let funs = { Mls_mapfold.defaults with edesc = edesc } in let n = node_by_longname ln in let _, acc = Mls_mapfold.node_dec funs [] n in - acc + acc (** @return the list of nodes called by the node named [ln]. This list is computed lazily the first time it is needed. *) diff --git a/lib/iostream.epi b/lib/iostream.epi index 3452876..acfecbc 100644 --- a/lib/iostream.epi +++ b/lib/iostream.epi @@ -9,5 +9,5 @@ const file stderr *) (* Basic Printing *) -unsafe val fun printf(string;...) returns () -unsafe val fun fprintf(file;string;...) returns () +external unsafe val fun printf(string;...) returns () +external unsafe val fun fprintf(file;string;...) returns () diff --git a/lib/pervasives.epi b/lib/pervasives.epi index 5c79c50..11cd252 100644 --- a/lib/pervasives.epi +++ b/lib/pervasives.epi @@ -4,37 +4,37 @@ type bool = true | false type int type float type string -val fun (&)(bool;bool) returns (bool) -val fun ( * )(int;int) returns (int) -val fun ( *. )(float;float) returns (float) -val fun (%)(int;int) returns (int) -val fun (+)(int;int) returns (int) -val fun (+.)(float;float) returns (float) -val fun (-)(int;int) returns (int) -val fun (-.)(float;float) returns (float) -val fun (/)(int;int) returns (int) -val fun (/.)(float;float) returns (float) -val fun ( = )(int;int) returns (bool) -val fun ( <= )(int;int) returns (bool) -val fun ( <=. )(float;float) returns (bool) -val fun ( < )(int;int) returns (bool) -val fun ( <. )(float;float) returns (bool) -val fun ( >= )(int;int) returns (bool) -val fun ( >=. )(float;float) returns (bool) -val fun ( > )(int;int) returns (bool) -val fun ( >. )(float;float) returns (bool) -val fun (not)(bool) returns (bool) -val fun (or)(bool;bool) returns (bool) -val fun (xor)(bool;bool) returns (bool) -val fun (~-)(int) returns (int) -val fun (~~)(int) returns (int) -val fun (>>>)(int;int) returns (int) -val fun (<<<)(int;int) returns (int) -val fun (&&&)(int;int) returns (int) -val fun (|||)(int;int) returns (int) -val fun (~-.)(float) returns (float) -val fun do_stuff(int) returns (int) -val fun between(int;int) returns (int) +external val fun (&)(bool;bool) returns (bool) +external val fun ( * )(int;int) returns (int) +external val fun ( *. )(float;float) returns (float) +external val fun (%)(int;int) returns (int) +external val fun (+)(int;int) returns (int) +external val fun (+.)(float;float) returns (float) +external val fun (-)(int;int) returns (int) +external val fun (-.)(float;float) returns (float) +external val fun (/)(int;int) returns (int) +external val fun (/.)(float;float) returns (float) +external val fun ( = )(int;int) returns (bool) +external val fun ( <= )(int;int) returns (bool) +external val fun ( <=. )(float;float) returns (bool) +external val fun ( < )(int;int) returns (bool) +external val fun ( <. )(float;float) returns (bool) +external val fun ( >= )(int;int) returns (bool) +external val fun ( >=. )(float;float) returns (bool) +external val fun ( > )(int;int) returns (bool) +external val fun ( >. )(float;float) returns (bool) +external val fun (not)(bool) returns (bool) +external val fun (or)(bool;bool) returns (bool) +external val fun (xor)(bool;bool) returns (bool) +external val fun (~-)(int) returns (int) +external val fun (~~)(int) returns (int) +external val fun (>>>)(int;int) returns (int) +external val fun (<<<)(int;int) returns (int) +external val fun (&&&)(int;int) returns (int) +external val fun (|||)(int;int) returns (int) +external val fun (~-.)(float) returns (float) +external val fun do_stuff(int) returns (int) +external val fun between(int;int) returns (int) -val fun exit(bool) returns () -val fun assert(bool) returns () +external val fun exit(bool) returns () +external val fun assert(bool) returns ()