Project

General

Profile

Download (3.53 KB) Statistics
| Branch: | Tag: | Revision:
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 *)
(26-26/64)