|
1
|
|
|
2
|
(********************************************************************)
|
|
3
|
(* *)
|
|
4
|
(* The LustreC compiler toolset / The LustreC Development Team *)
|
|
5
|
(* Copyright 2012 - -- ONERA - CNRS - INPT *)
|
|
6
|
(* *)
|
|
7
|
(* LustreC is free software, distributed WITHOUT ANY WARRANTY *)
|
|
8
|
(* under the terms of the GNU Lesser General Public License *)
|
|
9
|
(* version 2.1. *)
|
|
10
|
(* *)
|
|
11
|
(********************************************************************)
|
|
12
|
|
|
13
|
open Lustre_types
|
|
14
|
|
|
15
|
(********************************************************************************************)
|
|
16
|
(* Lusic to/from Header Printing functions *)
|
|
17
|
(********************************************************************************************)
|
|
18
|
|
|
19
|
type lusic =
|
|
20
|
{
|
|
21
|
obsolete : bool;
|
|
22
|
from_lusi : bool;
|
|
23
|
contents : top_decl list;
|
|
24
|
}
|
|
25
|
|
|
26
|
(* extracts a header from a program representing module owner = dirname/basename *)
|
|
27
|
let extract_header dirname basename prog =
|
|
28
|
let owner = dirname ^ "/" ^ basename in
|
|
29
|
List.fold_right
|
|
30
|
(fun decl header ->
|
|
31
|
(* Format.eprintf "Lusic.extract_header: header = %B, owner = %s, decl_owner = %s@."
|
|
32
|
* decl.top_decl_itf owner decl.top_decl_owner; *)
|
|
33
|
if decl.top_decl_itf || decl.top_decl_owner <> owner then header
|
|
34
|
else match decl.top_decl_desc with
|
|
35
|
| Node nd ->
|
|
36
|
{ decl with top_decl_desc =
|
|
37
|
ImportedNode (Corelang.get_node_interface nd) }
|
|
38
|
:: header
|
|
39
|
| ImportedNode _ -> header
|
|
40
|
| Const _ | TypeDef _ | Include _ | Open _ -> decl :: header)
|
|
41
|
prog []
|
|
42
|
|
|
43
|
let check_obsolete lusic basename =
|
|
44
|
if lusic.obsolete then raise (Error.Error (Location.dummy_loc, Error.Wrong_number basename))
|
|
45
|
|
|
46
|
(* encode and write a header in a file *)
|
|
47
|
let write_lusic lusi (header : top_decl list) basename extension =
|
|
48
|
let target_name = basename ^ extension in
|
|
49
|
let outchan = open_out_bin target_name in
|
|
50
|
begin
|
|
51
|
(*Format.eprintf "write_lusic: %i items.@." (List.length header);*)
|
|
52
|
Marshal.to_channel outchan (Version.number, lusi : string * bool) [];
|
|
53
|
Marshal.to_channel outchan (header : top_decl list) [];
|
|
54
|
close_out outchan
|
|
55
|
end
|
|
56
|
|
|
57
|
(* read and decode a header from a file *)
|
|
58
|
let read_lusic basename extension =
|
|
59
|
let source_name = basename ^ extension in
|
|
60
|
let inchan = open_in_bin source_name in
|
|
61
|
let number, from_lusi = (Marshal.from_channel inchan : string * bool) in
|
|
62
|
if number <> Version.number
|
|
63
|
then
|
|
64
|
begin
|
|
65
|
close_in inchan;
|
|
66
|
{
|
|
67
|
obsolete = true;
|
|
68
|
from_lusi = from_lusi;
|
|
69
|
contents = [];
|
|
70
|
}
|
|
71
|
end
|
|
72
|
else
|
|
73
|
begin
|
|
74
|
let lusic = (Marshal.from_channel inchan : top_decl list) in
|
|
75
|
close_in inchan;
|
|
76
|
{
|
|
77
|
obsolete = false;
|
|
78
|
from_lusi = from_lusi;
|
|
79
|
contents = lusic;
|
|
80
|
}
|
|
81
|
end
|
|
82
|
|
|
83
|
(* let print_lusic_to_h basename extension =
|
|
84
|
* let lusic = read_lusic basename extension in
|
|
85
|
* let header_name = basename ^ ".h" in
|
|
86
|
* let h_out = open_out header_name in
|
|
87
|
* let h_fmt = formatter_of_out_channel h_out in
|
|
88
|
* begin
|
|
89
|
* assert (not lusic.obsolete);
|
|
90
|
* (\*Format.eprintf "lusic to h: %i items.@." (List.length lusic.contents);*\)
|
|
91
|
* Typing.uneval_prog_generics lusic.contents;
|
|
92
|
* Clock_calculus.uneval_prog_generics lusic.contents;
|
|
93
|
* Header.print_header_from_header h_fmt (Filename.basename basename) lusic.contents;
|
|
94
|
* close_out h_out
|
|
95
|
* end *)
|