heptagon/compiler/global/signature.ml

123 lines
4.4 KiB
OCaml
Raw Normal View History

(***********************************************************************)
(* *)
(* Heptagon *)
(* *)
(* Gwenael Delaval, LIG/INRIA, UJF *)
(* Leonard Gerard, Parkas, ENS *)
(* Adrien Guatto, Parkas, ENS *)
(* Cedric Pasteur, Parkas, ENS *)
2012-06-29 01:43:15 +02:00
(* Marc Pouzet, Parkas, ENS *)
(* *)
(* Copyright 2012 ENS, INRIA, UJF *)
(* *)
(* This file is part of the Heptagon compiler. *)
(* *)
(* Heptagon is free software: you can redistribute it and/or modify it *)
(* under the terms of the GNU General Public License as published by *)
(* the Free Software Foundation, either version 3 of the License, or *)
(* (at your option) any later version. *)
(* *)
(* Heptagon is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU General Public License *)
(* along with Heptagon. If not, see <http://www.gnu.org/licenses/> *)
(* *)
(***********************************************************************)
(* global data in the symbol tables *)
open Names
open Types
2011-05-12 00:54:02 +02:00
open Location
2011-04-26 14:07:15 +02:00
open Linearity
(** Warning: Whenever these types are modified,
interface_format_version should be incremented. *)
let interface_format_version = "4"
2011-05-09 19:32:12 +02:00
type ck =
| Cbase
| Con of ck * constructor_name * name
2011-05-06 18:07:40 +02:00
(** Node argument : inputs and outputs *)
type arg = {
a_name : name option;
a_type : ty;
a_clock : ck; (** [a_clock] set to [Cbase] means at the node activation clock *)
a_linearity : linearity;
2011-05-06 18:07:40 +02:00
}
2010-07-07 12:15:02 +02:00
(** Node static parameters *)
2010-07-05 15:43:51 +02:00
type param = { p_name : name; p_type : ty }
(** Constraints on size expressions *)
type constrnt = static_exp
2010-07-08 14:56:49 +02:00
(** Node signature *)
type node = {
2011-05-06 18:07:40 +02:00
node_inputs : arg list;
node_outputs : arg list;
node_stateful : bool;
node_unsafe : bool;
2011-05-06 18:07:40 +02:00
node_params : param list;
node_param_constraints : constrnt list;
node_external : bool;
2011-05-12 00:54:02 +02:00
node_loc : location}
type field = { f_name : field_name; f_type : ty }
type structure = field list
type type_def =
| Tabstract
| Talias of ty
| Tenum of constructor_name list
| Tstruct of structure
type const_def = { c_type : ty; c_value : static_exp }
2011-05-12 00:54:02 +02:00
(** {3 Signature helper functions} *)
2011-05-12 00:54:02 +02:00
2011-05-09 19:32:12 +02:00
let rec ck_to_sck ck =
let ck = Clocks.ck_repr ck in
match ck with
| Clocks.Cbase -> Cbase
| Clocks.Con (ck,c,x) -> Con(ck_to_sck ck, c, Idents.source_name x)
2011-05-23 09:24:57 +02:00
| _ -> Misc.internal_error "Signature couldn't translate ck"
2011-05-09 19:32:12 +02:00
let names_of_arg_list l = List.map (fun ad -> ad.a_name) l
let types_of_arg_list l = List.map (fun ad -> ad.a_type) l
let types_of_param_list l = List.map (fun p -> p.p_type) l
2011-04-26 14:55:40 +02:00
let linearities_of_arg_list l = List.map (fun ad -> ad.a_linearity) l
2011-09-07 11:34:11 +02:00
let mk_arg name ty linearity ck =
{ a_type = ty; a_linearity = linearity; a_name = name; a_clock = ck }
2010-07-05 15:43:51 +02:00
let mk_param name ty = { p_name = name; p_type = ty }
2010-06-29 11:18:50 +02:00
2010-07-01 19:35:24 +02:00
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 ~extern ins outs stateful unsafe params =
{ node_inputs = ins;
node_outputs = outs;
2011-03-21 14:30:19 +01:00
node_stateful = stateful;
node_unsafe = unsafe;
node_params = params;
node_param_constraints = constraints;
node_external = extern;
2011-05-12 00:54:02 +02:00
node_loc = loc}
2010-06-17 13:05:16 +02:00
let rec field_assoc f = function
| [] -> raise Not_found
| { f_name = n; f_type = ty }::l ->
if f = n then ty
2010-07-14 00:55:40 +02:00
else field_assoc f l