Add [external] in the signatures. fix callgraph acordingly.

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

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 }
 

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 =

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");

compiler/heptagon/parsing/hept_parser.mly

@@ -19,7 +19,7 @@ open Hept_parsetree
 %token <bool> BOOL
 %token <string> STRING
 %token <string * string> 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)) }) }
 ;
 

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;

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

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 =

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 =

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 }

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. *)

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 ()

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 ()