Project

General

Profile

Download (3.39 KB) Statistics
| Branch: | Tag: | Revision:
1
(********************************************************************)
2
(*                                                                  *)
3
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
5
(*                                                                  *)
6
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
7
(*  under the terms of the GNU Lesser General Public License        *)
8
(*  version 2.1.                                                    *)
9
(*                                                                  *)
10
(********************************************************************)
11

    
12
open Lustre_types
13

    
14
(********************************************************************************************)
15
(* Lusic to/from Header Printing functions *)
16
(********************************************************************************************)
17

    
18
type lusic = { obsolete : bool; from_lusi : bool; contents : top_decl list }
19

    
20
(* extracts a header from a program representing module owner = dirname/basename *)
21
let extract_header dirname basename prog =
22
  let owner = dirname ^ "/" ^ basename in
23
  List.fold_right
24
    (fun 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)
40
    prog []
41

    
42
let check_obsolete lusic basename =
43
  if lusic.obsolete then
44
    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
  (*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
54

    
55
(* read and decode a header from a file *)
56
let read_lusic basename extension =
57
  let source_name = basename ^ extension in
58
  let inchan = open_in_bin source_name in
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 }
67

    
68
(* let print_lusic_to_h basename extension =
69
 *   let lusic = read_lusic basename extension in
70
 *   let header_name = basename ^ ".h" in
71
 *   let h_out = open_out header_name in
72
 *   let h_fmt = formatter_of_out_channel h_out in
73
 *   begin
74
 *     assert (not lusic.obsolete);
75
 *     (\*Format.eprintf "lusic to h: %i items.@." (List.length lusic.contents);*\)
76
 *     Typing.uneval_prog_generics lusic.contents;
77
 *     Clock_calculus.uneval_prog_generics lusic.contents;
78
 *     Header.print_header_from_header h_fmt (Filename.basename basename) lusic.contents;
79
 *     close_out h_out
80
 *   end *)
(26-26/66)