Add [external] in the signatures. fix callgraph acordingly.
This commit is contained in:
parent
c1b8e47ffb
commit
8a78bc7d7d
|
@ -14,7 +14,7 @@ open Linearity
|
||||||
|
|
||||||
(** Warning: Whenever these types are modified,
|
(** Warning: Whenever these types are modified,
|
||||||
interface_format_version should be incremented. *)
|
interface_format_version should be incremented. *)
|
||||||
let interface_format_version = "30"
|
let interface_format_version = "4"
|
||||||
|
|
||||||
type ck =
|
type ck =
|
||||||
| Cbase
|
| Cbase
|
||||||
|
@ -42,6 +42,7 @@ type node = {
|
||||||
node_unsafe : bool;
|
node_unsafe : bool;
|
||||||
node_params : param list;
|
node_params : param list;
|
||||||
node_param_constraints : constrnt list;
|
node_param_constraints : constrnt list;
|
||||||
|
node_external : bool;
|
||||||
node_loc : location}
|
node_loc : location}
|
||||||
|
|
||||||
type field = { f_name : field_name; f_type : ty }
|
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 =
|
let mk_const_def ty value =
|
||||||
{ c_type = ty; c_value = 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_inputs = ins;
|
||||||
node_outputs = outs;
|
node_outputs = outs;
|
||||||
node_stateful = stateful;
|
node_stateful = stateful;
|
||||||
node_unsafe = unsafe;
|
node_unsafe = unsafe;
|
||||||
node_params = params;
|
node_params = params;
|
||||||
node_param_constraints = constraints;
|
node_param_constraints = constraints;
|
||||||
|
node_external = extern;
|
||||||
node_loc = loc}
|
node_loc = loc}
|
||||||
|
|
||||||
let rec field_assoc f = function
|
let rec field_assoc f = function
|
||||||
|
|
|
@ -63,13 +63,14 @@ let mk_simple_equation pat e =
|
||||||
let mk_switch_equation e l =
|
let mk_switch_equation e l =
|
||||||
mk_equation (Eswitch (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_name = name;
|
||||||
sig_inputs = ins;
|
sig_inputs = ins;
|
||||||
sig_stateful = stateful;
|
sig_stateful = stateful;
|
||||||
sig_outputs = outs;
|
sig_outputs = outs;
|
||||||
sig_params = params;
|
sig_params = params;
|
||||||
sig_param_constraints = constraints;
|
sig_param_constraints = constraints;
|
||||||
|
sig_external = extern;
|
||||||
sig_loc = loc }
|
sig_loc = loc }
|
||||||
|
|
||||||
let mk_node
|
let mk_node
|
||||||
|
@ -116,5 +117,6 @@ let signature_of_node n =
|
||||||
node_unsafe = n.n_unsafe;
|
node_unsafe = n.n_unsafe;
|
||||||
node_params = n.n_params;
|
node_params = n.n_params;
|
||||||
node_param_constraints = n.n_param_constraints;
|
node_param_constraints = n.n_param_constraints;
|
||||||
|
node_external = false;
|
||||||
node_loc = n.n_loc }
|
node_loc = n.n_loc }
|
||||||
|
|
||||||
|
|
|
@ -183,6 +183,7 @@ type signature = {
|
||||||
sig_outputs : arg list;
|
sig_outputs : arg list;
|
||||||
sig_params : param list;
|
sig_params : param list;
|
||||||
sig_param_constraints : constrnt list;
|
sig_param_constraints : constrnt list;
|
||||||
|
sig_external : bool;
|
||||||
sig_loc : location }
|
sig_loc : location }
|
||||||
|
|
||||||
type interface =
|
type interface =
|
||||||
|
|
|
@ -69,6 +69,7 @@ List.iter (fun (str,tok) -> Hashtbl.add keyword_table str tok) [
|
||||||
"split", SPLIT;
|
"split", SPLIT;
|
||||||
"reinit", REINIT;
|
"reinit", REINIT;
|
||||||
"unsafe", UNSAFE;
|
"unsafe", UNSAFE;
|
||||||
|
"external", EXTERNAL;
|
||||||
"quo", INFIX3("quo");
|
"quo", INFIX3("quo");
|
||||||
"mod", INFIX3("mod");
|
"mod", INFIX3("mod");
|
||||||
"land", INFIX3("land");
|
"land", INFIX3("land");
|
||||||
|
|
|
@ -19,7 +19,7 @@ open Hept_parsetree
|
||||||
%token <bool> BOOL
|
%token <bool> BOOL
|
||||||
%token <string> STRING
|
%token <string> STRING
|
||||||
%token <string * string> PRAGMA
|
%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 FBY PRE SWITCH EVERY
|
||||||
%token OR STAR NOT
|
%token OR STAR NOT
|
||||||
%token AMPERSAND
|
%token AMPERSAND
|
||||||
|
@ -663,10 +663,14 @@ unsafe:
|
||||||
| UNSAFE { true }
|
| UNSAFE { true }
|
||||||
| /*empty*/ { false }
|
| /*empty*/ { false }
|
||||||
|
|
||||||
|
extern:
|
||||||
|
| EXTERNAL { true }
|
||||||
|
| /*empty*/ { false }
|
||||||
|
|
||||||
interface_desc:
|
interface_desc:
|
||||||
| type_dec { Itypedef $1 }
|
| type_dec { Itypedef $1 }
|
||||||
| const_dec { Iconstdef $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
|
returns LPAREN o=params_signature RPAREN
|
||||||
{ Isignature({ sig_name = f;
|
{ Isignature({ sig_name = f;
|
||||||
sig_inputs = i;
|
sig_inputs = i;
|
||||||
|
@ -675,6 +679,7 @@ interface_desc:
|
||||||
sig_outputs = o;
|
sig_outputs = o;
|
||||||
sig_params = fst pc;
|
sig_params = fst pc;
|
||||||
sig_param_constraints = snd pc;
|
sig_param_constraints = snd pc;
|
||||||
|
sig_external = e;
|
||||||
sig_loc = (Loc($startpos,$endpos)) }) }
|
sig_loc = (Loc($startpos,$endpos)) }) }
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
@ -219,6 +219,7 @@ type signature =
|
||||||
sig_outputs : arg list;
|
sig_outputs : arg list;
|
||||||
sig_params : var_dec list;
|
sig_params : var_dec list;
|
||||||
sig_param_constraints : exp list;
|
sig_param_constraints : exp list;
|
||||||
|
sig_external : bool;
|
||||||
sig_loc : location }
|
sig_loc : location }
|
||||||
|
|
||||||
type interface =
|
type interface =
|
||||||
|
|
|
@ -171,13 +171,14 @@ let mk_app ?(params=[]) ?(unsafe=false) ?(inlined = false) op =
|
||||||
Heptagon.a_unsafe = unsafe;
|
Heptagon.a_unsafe = unsafe;
|
||||||
Heptagon.a_inlined = inlined }
|
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_name = name;
|
||||||
Heptagon.sig_inputs = ins;
|
Heptagon.sig_inputs = ins;
|
||||||
Heptagon.sig_stateful = stateful;
|
Heptagon.sig_stateful = stateful;
|
||||||
Heptagon.sig_outputs = outs;
|
Heptagon.sig_outputs = outs;
|
||||||
Heptagon.sig_params = params;
|
Heptagon.sig_params = params;
|
||||||
Heptagon.sig_param_constraints = constraints;
|
Heptagon.sig_param_constraints = constraints;
|
||||||
|
Heptagon.sig_external = extern;
|
||||||
Heptagon.sig_loc = loc }
|
Heptagon.sig_loc = loc }
|
||||||
|
|
||||||
|
|
||||||
|
@ -547,10 +548,10 @@ let translate_signature s =
|
||||||
let o = List.map translate_arg s.sig_outputs in
|
let o = List.map translate_arg s.sig_outputs in
|
||||||
let p, _ = params_of_var_decs Rename.empty s.sig_params 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 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;
|
Check_signature.check_signature sig_node;
|
||||||
safe_add s.sig_loc add_value n 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
|
let translate_interface_desc = function
|
||||||
|
|
|
@ -239,6 +239,7 @@ let signature s =
|
||||||
sig_outputs = s.Heptagon.sig_outputs;
|
sig_outputs = s.Heptagon.sig_outputs;
|
||||||
sig_params = s.Heptagon.sig_params;
|
sig_params = s.Heptagon.sig_params;
|
||||||
sig_param_constraints = s.Heptagon.sig_param_constraints;
|
sig_param_constraints = s.Heptagon.sig_param_constraints;
|
||||||
|
sig_external = s.Heptagon.sig_external;
|
||||||
sig_loc = s.Heptagon.sig_loc }
|
sig_loc = s.Heptagon.sig_loc }
|
||||||
|
|
||||||
let interface i =
|
let interface i =
|
||||||
|
|
|
@ -166,6 +166,7 @@ type signature = {
|
||||||
sig_outputs : arg list;
|
sig_outputs : arg list;
|
||||||
sig_params : param list;
|
sig_params : param list;
|
||||||
sig_param_constraints : constrnt list;
|
sig_param_constraints : constrnt list;
|
||||||
|
sig_external : bool;
|
||||||
sig_loc : location }
|
sig_loc : location }
|
||||||
|
|
||||||
type interface =
|
type interface =
|
||||||
|
|
|
@ -266,4 +266,5 @@ let signature_of_node n =
|
||||||
node_unsafe = n.n_unsafe;
|
node_unsafe = n.n_unsafe;
|
||||||
node_params = n.n_params;
|
node_params = n.n_params;
|
||||||
node_param_constraints = n.n_param_constraints;
|
node_param_constraints = n.n_param_constraints;
|
||||||
|
node_external = false;
|
||||||
node_loc = n.n_loc }
|
node_loc = n.n_loc }
|
||||||
|
|
|
@ -268,13 +268,14 @@ let node_by_longname node =
|
||||||
(** @return the list of nodes called by the node named [ln], with the
|
(** @return the list of nodes called by the node named [ln], with the
|
||||||
corresponding params (static parameters appear as free variables). *)
|
corresponding params (static parameters appear as free variables). *)
|
||||||
let collect_node_calls ln =
|
let collect_node_calls ln =
|
||||||
|
(** only add nodes when not external and with params *)
|
||||||
let add_called_node ln params acc =
|
let add_called_node ln params acc =
|
||||||
match params with
|
match params with
|
||||||
| [] -> acc
|
| [] -> acc
|
||||||
| _ ->
|
| _ ->
|
||||||
(match ln with
|
if (Modules.find_value ln).node_external
|
||||||
| { qual = Pervasives } -> acc
|
then acc
|
||||||
| _ -> (ln, params)::acc)
|
else (ln, params)::acc
|
||||||
in
|
in
|
||||||
let edesc _ acc ed = match ed with
|
let edesc _ acc ed = match ed with
|
||||||
| Eapp ({ a_op = (Enode ln | Efun ln); a_params = params }, _, _) ->
|
| Eapp ({ a_op = (Enode ln | Efun ln); a_params = params }, _, _) ->
|
||||||
|
|
|
@ -9,5 +9,5 @@ const file stderr
|
||||||
*)
|
*)
|
||||||
|
|
||||||
(* Basic Printing *)
|
(* Basic Printing *)
|
||||||
unsafe val fun printf(string;...) returns ()
|
external unsafe val fun printf(string;...) returns ()
|
||||||
unsafe val fun fprintf(file;string;...) returns ()
|
external unsafe val fun fprintf(file;string;...) returns ()
|
||||||
|
|
|
@ -4,37 +4,37 @@ type bool = true | false
|
||||||
type int
|
type int
|
||||||
type float
|
type float
|
||||||
type string
|
type string
|
||||||
val fun (&)(bool;bool) returns (bool)
|
external val fun (&)(bool;bool) returns (bool)
|
||||||
val fun ( * )(int;int) returns (int)
|
external val fun ( * )(int;int) returns (int)
|
||||||
val fun ( *. )(float;float) returns (float)
|
external val fun ( *. )(float;float) returns (float)
|
||||||
val fun (%)(int;int) returns (int)
|
external val fun (%)(int;int) returns (int)
|
||||||
val fun (+)(int;int) returns (int)
|
external val fun (+)(int;int) returns (int)
|
||||||
val fun (+.)(float;float) returns (float)
|
external val fun (+.)(float;float) returns (float)
|
||||||
val fun (-)(int;int) returns (int)
|
external val fun (-)(int;int) returns (int)
|
||||||
val fun (-.)(float;float) returns (float)
|
external val fun (-.)(float;float) returns (float)
|
||||||
val fun (/)(int;int) returns (int)
|
external val fun (/)(int;int) returns (int)
|
||||||
val fun (/.)(float;float) returns (float)
|
external val fun (/.)(float;float) returns (float)
|
||||||
val fun ( = )(int;int) returns (bool)
|
external val fun ( = )(int;int) returns (bool)
|
||||||
val fun ( <= )(int;int) returns (bool)
|
external val fun ( <= )(int;int) returns (bool)
|
||||||
val fun ( <=. )(float;float) returns (bool)
|
external val fun ( <=. )(float;float) returns (bool)
|
||||||
val fun ( < )(int;int) returns (bool)
|
external val fun ( < )(int;int) returns (bool)
|
||||||
val fun ( <. )(float;float) returns (bool)
|
external val fun ( <. )(float;float) returns (bool)
|
||||||
val fun ( >= )(int;int) returns (bool)
|
external val fun ( >= )(int;int) returns (bool)
|
||||||
val fun ( >=. )(float;float) returns (bool)
|
external val fun ( >=. )(float;float) returns (bool)
|
||||||
val fun ( > )(int;int) returns (bool)
|
external val fun ( > )(int;int) returns (bool)
|
||||||
val fun ( >. )(float;float) returns (bool)
|
external val fun ( >. )(float;float) returns (bool)
|
||||||
val fun (not)(bool) returns (bool)
|
external val fun (not)(bool) returns (bool)
|
||||||
val fun (or)(bool;bool) returns (bool)
|
external val fun (or)(bool;bool) returns (bool)
|
||||||
val fun (xor)(bool;bool) returns (bool)
|
external val fun (xor)(bool;bool) returns (bool)
|
||||||
val fun (~-)(int) returns (int)
|
external val fun (~-)(int) returns (int)
|
||||||
val fun (~~)(int) returns (int)
|
external val fun (~~)(int) returns (int)
|
||||||
val fun (>>>)(int;int) returns (int)
|
external val fun (>>>)(int;int) returns (int)
|
||||||
val fun (<<<)(int;int) returns (int)
|
external val fun (<<<)(int;int) returns (int)
|
||||||
val fun (&&&)(int;int) returns (int)
|
external val fun (&&&)(int;int) returns (int)
|
||||||
val fun (|||)(int;int) returns (int)
|
external val fun (|||)(int;int) returns (int)
|
||||||
val fun (~-.)(float) returns (float)
|
external val fun (~-.)(float) returns (float)
|
||||||
val fun do_stuff(int) returns (int)
|
external val fun do_stuff(int) returns (int)
|
||||||
val fun between(int;int) returns (int)
|
external val fun between(int;int) returns (int)
|
||||||
|
|
||||||
val fun exit(bool) returns ()
|
external val fun exit(bool) returns ()
|
||||||
val fun assert(bool) returns ()
|
external val fun assert(bool) returns ()
|
||||||
|
|
Loading…
Reference in a new issue