Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / lusic.ml @ ef34b4ae

History | View | Annotate | Download (2.77 KB)

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 LustreSpec
15
open Corelang
16

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

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

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

    
29
(* extracts a header from a program representing module own *)
30
let extract_header own prog =
31
 List.fold_right
32
   (fun decl header ->
33
     if decl.top_decl_itf || decl.top_decl_owner <> own then header else
34
    match decl.top_decl_desc with
35
    | Node nd        -> { decl with top_decl_desc = ImportedNode (Corelang.get_node_interface nd) } :: header 
36
    | ImportedNode _ -> header
37
    | Const _
38
    | TypeDef _
39
    | Open _         -> decl :: header)
40
   prog []
41

    
42
(* encode and write a header in a file *)
43
let write_lusic lusi (header : top_decl list) basename extension =
44
  let basename' = !Options.dest_dir ^ "/" ^ basename in
45
  let target_name = basename' ^ extension in
46
  let outchan = open_out_bin target_name in
47
  begin
48
    Marshal.to_channel outchan {from_lusi = lusi; contents = header} [];
49
    close_out outchan
50
  end
51

    
52
(* read and decode a header from a file *)
53
let read_lusic basename extension =
54
  let basename' = !Options.dest_dir ^ "/" ^ basename in
55
  let source_name = basename' ^ extension in
56
  let inchan = open_in_bin source_name in
57
  let lusic = (Marshal.from_channel inchan : lusic) in
58
  begin
59
    close_in inchan;
60
    lusic
61
  end
62

    
63
let print_lusic_to_h basename extension =
64
  let basename' = !Options.dest_dir ^ "/" ^ basename in
65
  let lusic = read_lusic basename extension in
66
  let header_name = basename' ^ ".h" in
67
  let h_out = open_out header_name in
68
  let h_fmt = formatter_of_out_channel h_out in
69
  begin
70
    Typing.uneval_prog_generics lusic.contents;
71
    Clock_calculus.uneval_prog_generics lusic.contents;
72
    Header.print_header_from_header h_fmt basename lusic.contents;
73
    close_out h_out
74
  end
75

    
76