lustrec / src / lusic.ml @ ef34b4ae
History | View | Annotate | Download (2.77 KB)
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 Format |
14 |
open LustreSpec |
15 |
open Corelang |
16 |
|
17 |
(********************************************************************************************) |
18 |
(* Lusic to/from Header Printing functions *) |
19 |
(********************************************************************************************) |
20 |
|
21 |
type lusic = |
22 |
{ from_lusi : bool; |
23 |
contents : top_decl list; |
24 |
} |
25 |
|
26 |
module HeaderMod = C_backend_header.EmptyMod |
27 |
module Header = C_backend_header.Main (HeaderMod) |
28 |
|
29 |
(* extracts a header from a program representing module own *) |
30 |
let extract_header own prog = |
31 |
List.fold_right |
32 |
(fun decl header -> |
33 |
if decl.top_decl_itf || decl.top_decl_owner <> own then header else |
34 |
match decl.top_decl_desc with |
35 |
| Node nd -> { decl with top_decl_desc = ImportedNode (Corelang.get_node_interface nd) } :: header |
36 |
| ImportedNode _ -> header |
37 |
| Const _ |
38 |
| TypeDef _ |
39 |
| Open _ -> decl :: header) |
40 |
prog [] |
41 |
|
42 |
(* encode and write a header in a file *) |
43 |
let write_lusic lusi (header : top_decl list) basename extension = |
44 |
let basename' = !Options.dest_dir ^ "/" ^ basename in |
45 |
let target_name = basename' ^ extension in |
46 |
let outchan = open_out_bin target_name in |
47 |
begin |
48 |
Marshal.to_channel outchan {from_lusi = lusi; contents = header} []; |
49 |
close_out outchan |
50 |
end |
51 |
|
52 |
(* read and decode a header from a file *) |
53 |
let read_lusic basename extension = |
54 |
let basename' = !Options.dest_dir ^ "/" ^ basename in |
55 |
let source_name = basename' ^ extension in |
56 |
let inchan = open_in_bin source_name in |
57 |
let lusic = (Marshal.from_channel inchan : lusic) in |
58 |
begin |
59 |
close_in inchan; |
60 |
lusic |
61 |
end |
62 |
|
63 |
let print_lusic_to_h basename extension = |
64 |
let basename' = !Options.dest_dir ^ "/" ^ basename in |
65 |
let lusic = read_lusic basename extension in |
66 |
let header_name = basename' ^ ".h" in |
67 |
let h_out = open_out header_name in |
68 |
let h_fmt = formatter_of_out_channel h_out in |
69 |
begin |
70 |
Typing.uneval_prog_generics lusic.contents; |
71 |
Clock_calculus.uneval_prog_generics lusic.contents; |
72 |
Header.print_header_from_header h_fmt basename lusic.contents; |
73 |
close_out h_out |
74 |
end |
75 |
|
76 |
|