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