Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / lusic.ml @ master

History | View | Annotate | Download (3.52 KB)

1 ef34b4ae xthirioux
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 8446bf03 ploc
open Lustre_types
15 ef34b4ae xthirioux
open Corelang
16
17
(********************************************************************************************)
18
(*                      Lusic to/from Header Printing functions                             *)
19
(********************************************************************************************)
20
21
type lusic =
22 ec433d69 xthirioux
{
23
  obsolete  : bool;
24
  from_lusi : bool;
25 ef34b4ae xthirioux
  contents  : top_decl list;
26
}
27
28
module HeaderMod = C_backend_header.EmptyMod
29
module Header = C_backend_header.Main (HeaderMod)
30
31 6efbcb73 xthirioux
(* extracts a header from a program representing module owner = dirname/basename *)
32
let extract_header dirname basename prog =
33
  let owner = dirname ^ "/" ^ basename in
34 990210f3 ploc
  List.fold_right
35
    (fun decl header ->
36
      (*Format.eprintf "Lusic.extract_header: header = %B, owner = %s, decl_owner = %s@." decl.top_decl_itf owner decl.top_decl_owner;*)
37
      if decl.top_decl_itf || decl.top_decl_owner <> owner then header else
38
	match decl.top_decl_desc with
39
	| Node nd        -> { decl with top_decl_desc = ImportedNode (Corelang.get_node_interface nd) } :: header 
40
	| ImportedNode _ -> header
41
	| Const _
42
	| TypeDef _
43
	| Open _         -> decl :: header)
44
    prog []
45 ef34b4ae xthirioux
46 ec433d69 xthirioux
let check_obsolete lusic basename =
47 e7cc5186 ploc
  if lusic.obsolete then raise (Error (Location.dummy_loc, Error.Wrong_number basename))
48 ec433d69 xthirioux
49 ef34b4ae xthirioux
(* encode and write a header in a file *)
50
let write_lusic lusi (header : top_decl list) basename extension =
51 9603460e xthirioux
  let target_name = basename ^ extension in
52 ef34b4ae xthirioux
  let outchan = open_out_bin target_name in
53
  begin
54 04a63d25 xthirioux
    (*Format.eprintf "write_lusic: %i items.@." (List.length header);*)
55 ec433d69 xthirioux
    Marshal.to_channel outchan (Version.number, lusi : string * bool) [];
56
    Marshal.to_channel outchan (header : top_decl list) [];
57 ef34b4ae xthirioux
    close_out outchan
58
  end
59
60
(* read and decode a header from a file *)
61
let read_lusic basename extension =
62 9603460e xthirioux
  let source_name = basename ^ extension in
63 ef34b4ae xthirioux
  let inchan = open_in_bin source_name in
64 ec433d69 xthirioux
  let number, from_lusi = (Marshal.from_channel inchan : string * bool) in
65
  if number <> Version.number
66
  then
67
    begin
68
      close_in inchan;
69
      {
70
	obsolete  = true;
71
	from_lusi = from_lusi;
72
	contents  = [];
73
      }
74
    end
75
  else    
76
    begin
77
      let lusic = (Marshal.from_channel inchan : top_decl list) in
78
      close_in inchan;
79
      {
80
	obsolete  = false;
81
	from_lusi = from_lusi;
82
	contents  = lusic;
83
      }
84
    end
85 ef34b4ae xthirioux
86
let print_lusic_to_h basename extension =
87
  let lusic = read_lusic basename extension in
88 9603460e xthirioux
  let header_name = basename ^ ".h" in
89 ef34b4ae xthirioux
  let h_out = open_out header_name in
90
  let h_fmt = formatter_of_out_channel h_out in
91
  begin
92 a28d1ba7 xthirioux
    assert (not lusic.obsolete);
93 04a63d25 xthirioux
    (*Format.eprintf "lusic to h: %i items.@." (List.length lusic.contents);*)
94 ef34b4ae xthirioux
    Typing.uneval_prog_generics lusic.contents;
95
    Clock_calculus.uneval_prog_generics lusic.contents;
96 9603460e xthirioux
    Header.print_header_from_header h_fmt (Filename.basename basename) lusic.contents;
97 ef34b4ae xthirioux
    close_out h_out
98
  end
99