Revision ca7ff3f7
Added by Lélio Brun 7 months 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