jeltz/heptagon
1
0
Fork 0
Code Issues Pull requests Releases Activity

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

Browse source
This commit is contained in:
Léonard Gérard 2012-02-21 16:07:29 +01:00
parent c1b8e47ffb
commit 8a78bc7d7d
13 changed files with 71 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
compiler/global/signature.ml
View file

@ -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

4
compiler/heptagon/hept_utils.ml
View file

@ -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 }

1
compiler/heptagon/heptagon.ml
View file

@ -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 =

1
compiler/heptagon/parsing/hept_lexer.mll
View file

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

9
compiler/heptagon/parsing/hept_parser.mly
View file

@ -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)) }) }
;

15
compiler/heptagon/parsing/hept_parsetree.ml
View file

@ -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;

7
compiler/heptagon/parsing/hept_scoping.ml
View file

@ -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

1
compiler/main/hept2mls.ml
View file

@ -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 =

1
compiler/minils/minils.ml
View file

@ -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 =

1
compiler/minils/mls_utils.ml
View file

@ -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 }

9
compiler/minils/transformations/callgraph.ml
View file

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

4
lib/iostream.epi
View file

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

66
lib/pervasives.epi
View file

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