Project

General

Profile

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

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

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

    
28

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

    
44
let check_obsolete lusic basename =
45
  if lusic.obsolete then raise (Error (Location.dummy_loc, Wrong_number basename))
46

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

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

    
84

    
(29-29/62)