Revision ca7ff3f7
Added by Lélio Brun over 1 year ago
src/lusic.ml | ||
---|---|---|
1 |
|
|
2 | 1 |
(********************************************************************) |
3 | 2 |
(* *) |
4 | 3 |
(* The LustreC compiler toolset / The LustreC Development Team *) |
... | ... | |
13 | 12 |
open Lustre_types |
14 | 13 |
|
15 | 14 |
(********************************************************************************************) |
16 |
(* Lusic to/from Header Printing functions *)
|
|
15 |
(* Lusic to/from Header Printing functions *)
|
|
17 | 16 |
(********************************************************************************************) |
18 | 17 |
|
19 |
type lusic = |
|
20 |
{ |
|
21 |
obsolete : bool; |
|
22 |
from_lusi : bool; |
|
23 |
contents : top_decl list; |
|
24 |
} |
|
18 |
type lusic = { obsolete : bool; from_lusi : bool; contents : top_decl list } |
|
25 | 19 |
|
26 | 20 |
(* extracts a header from a program representing module owner = dirname/basename *) |
27 | 21 |
let extract_header dirname basename prog = |
28 | 22 |
let owner = dirname ^ "/" ^ basename in |
29 | 23 |
List.fold_right |
30 | 24 |
(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) |
|
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) |
|
41 | 40 |
prog [] |
42 | 41 |
|
43 | 42 |
let check_obsolete lusic basename = |
44 |
if lusic.obsolete then raise (Error.Error (Location.dummy_loc, Error.Wrong_number basename)) |
|
43 |
if lusic.obsolete then |
|
44 |
raise (Error.Error (Location.dummy_loc, Error.Wrong_number basename)) |
|
45 | 45 |
|
46 | 46 |
(* encode and write a header in a file *) |
47 | 47 |
let write_lusic lusi (header : top_decl list) basename extension = |
48 | 48 |
let target_name = basename ^ extension in |
49 | 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 |
|
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 |
|
56 | 54 |
|
57 | 55 |
(* read and decode a header from a file *) |
58 | 56 |
let read_lusic basename extension = |
59 | 57 |
let source_name = basename ^ extension in |
60 | 58 |
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 |
|
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 } |
|
82 | 67 |
|
83 | 68 |
(* let print_lusic_to_h basename extension = |
84 | 69 |
* let lusic = read_lusic basename extension in |
Also available in: Unified diff
reformatting