Project

General

Profile

Download (3.6 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 Format 
14
open Lustre_types
15

    
16
(********************************************************************************************)
17
(*                      Lusic to/from Header Printing functions                             *)
18
(********************************************************************************************)
19

    
20
type lusic =
21
{
22
  obsolete  : bool;
23
  from_lusi : bool;
24
  contents  : top_decl list;
25
}
26

    
27
module HeaderMod = C_backend_header.EmptyMod
28
module Header = C_backend_header.Main (HeaderMod)
29

    
30
(* extracts a header from a program representing module owner = dirname/basename *)
31
let extract_header dirname basename prog =
32
  let owner = dirname ^ "/" ^ basename in
33
  List.fold_right
34
    (fun decl header ->
35
       (* Format.eprintf "Lusic.extract_header: header = %B, owner = %s, decl_owner = %s@."
36
        *   decl.top_decl_itf owner decl.top_decl_owner; *)
37
       if decl.top_decl_itf || decl.top_decl_owner <> owner then header
38
       else match decl.top_decl_desc with
39
         | Node nd ->
40
           { decl with top_decl_desc =
41
                         ImportedNode (Corelang.get_node_interface nd) }
42
           :: header
43
         | ImportedNode _ -> header
44
         | Const _ | TypeDef _ | Include _ | Open _  -> decl :: header)
45
    prog []
46

    
47
let check_obsolete lusic basename =
48
  if lusic.obsolete then raise (Error.Error (Location.dummy_loc, Error.Wrong_number basename))
49

    
50
(* encode and write a header in a file *)
51
let write_lusic lusi (header : top_decl list) basename extension =
52
  let target_name = basename ^ extension in
53
  let outchan = open_out_bin target_name in
54
  begin
55
    (*Format.eprintf "write_lusic: %i items.@." (List.length header);*)
56
    Marshal.to_channel outchan (Version.number, lusi : string * bool) [];
57
    Marshal.to_channel outchan (header : top_decl list) [];
58
    close_out outchan
59
  end
60

    
61
(* read and decode a header from a file *)
62
let read_lusic basename extension =
63
  let source_name = basename ^ extension in
64
  let inchan = open_in_bin source_name in
65
  let number, from_lusi = (Marshal.from_channel inchan : string * bool) in
66
  if number <> Version.number
67
  then
68
    begin
69
      close_in inchan;
70
      {
71
	obsolete  = true;
72
	from_lusi = from_lusi;
73
	contents  = [];
74
      }
75
    end
76
  else    
77
    begin
78
      let lusic = (Marshal.from_channel inchan : top_decl list) in
79
      close_in inchan;
80
      {
81
	obsolete  = false;
82
	from_lusi = from_lusi;
83
	contents  = lusic;
84
      }
85
    end
86

    
87
let print_lusic_to_h basename extension =
88
  let lusic = read_lusic basename extension in
89
  let header_name = basename ^ ".h" in
90
  let h_out = open_out header_name in
91
  let h_fmt = formatter_of_out_channel h_out in
92
  begin
93
    assert (not lusic.obsolete);
94
    (*Format.eprintf "lusic to h: %i items.@." (List.length lusic.contents);*)
95
    Typing.uneval_prog_generics lusic.contents;
96
    Clock_calculus.uneval_prog_generics lusic.contents;
97
    Header.print_header_from_header h_fmt (Filename.basename basename) lusic.contents;
98
    close_out h_out
99
  end
100

    
101

    
(26-26/63)