Project

General

Profile

Revision 01d48bb0 src/lusic.ml

View differences:

src/lusic.ml
19 19
(********************************************************************************************)
20 20

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

  
......
41 43
    | Open _         -> decl :: header)
42 44
   prog []
43 45

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

  
49
let check_lusic lusic basename =
50
  try
51
    check_obsolete lusic basename
52
  with
53
  | Corelang.Error (loc, err) as exc -> (
54
    eprintf "Library error: %a%a@."
55
      Corelang.pp_error err
56
      Location.pp_loc loc;
57
    raise exc
58
  )
59

  
44 60
(* encode and write a header in a file *)
45 61
let write_lusic lusi (header : top_decl list) basename extension =
46 62
  let target_name = basename ^ extension in
47 63
  let outchan = open_out_bin target_name in
48 64
  begin
49
    Marshal.to_channel outchan {from_lusi = lusi; contents = header} [];
65
    Marshal.to_channel outchan (Version.number, lusi : string * bool) [];
66
    Marshal.to_channel outchan (header : top_decl list) [];
50 67
    close_out outchan
51 68
  end
52 69

  
......
54 71
let read_lusic basename extension =
55 72
  let source_name = basename ^ extension in
56 73
  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
74
  let number, from_lusi = (Marshal.from_channel inchan : string * bool) in
75
  if number <> Version.number
76
  then
77
    begin
78
      close_in inchan;
79
      {
80
	obsolete  = true;
81
	from_lusi = from_lusi;
82
	contents  = [];
83
      }
84
    end
85
  else    
86
    begin
87
      let lusic = (Marshal.from_channel inchan : top_decl list) in
88
      close_in inchan;
89
      {
90
	obsolete  = false;
91
	from_lusi = from_lusi;
92
	contents  = lusic;
93
      }
94
    end
62 95

  
63 96
let print_lusic_to_h basename extension =
64 97
  let lusic = read_lusic basename extension in
......
66 99
  let h_out = open_out header_name in
67 100
  let h_fmt = formatter_of_out_channel h_out in
68 101
  begin
102
    check_lusic lusic basename;
69 103
    Typing.uneval_prog_generics lusic.contents;
70 104
    Clock_calculus.uneval_prog_generics lusic.contents;
71 105
    Header.print_header_from_header h_fmt (Filename.basename basename) lusic.contents;

Also available in: Unified diff