(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
                , projet Cristal , INRIA Rocquencourt           
                       , Jane Street Europe                     
(*                                                                        *)
    Copyright 1996 Institut National de Recherche en Informatique et     
(*     en Automatique.                                                    *)
    Copyright 2019 Jane Street Group LLC                                 
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
    the GNU Lesser General Public License version 2.1 , with the          
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

  Marshal and unmarshal a compilation unit in linear format
type linear_item_info =
  | Func of Linear.fundecl
  | Data of Cmm.data_item list

type linear_unit_info =
  {
    mutable unit : Compilation_unit.t;
    mutable items : linear_item_info list;
  }

type error =
  | Wrong_format of string
  | Wrong_version of string
  | Corrupted of string
  | Marshal_failed of string

exception Error of error

let save filename linear_unit_info =
  let ch = open_out_bin filename in
  Misc.try_finally (fun () ->
    output_string ch Config.linear_magic_number;
    output_value ch linear_unit_info;
  Saved because  and Emit depend on Cmm.label .
    output_value ch (Cmm.cur_label ());
  Compute digest of the contents and append it to the file .
    flush ch;
    let crc = Digest.file filename in
    output_value ch crc
  )
    ~always:(fun () -> close_out ch)
    ~exceptionally:(fun () -> raise (Error (Marshal_failed filename)))

let restore filename =
  let ic = open_in_bin filename in
  Misc.try_finally
    (fun () ->
       let magic = Config.linear_magic_number in
       let buffer = really_input_string ic (String.length magic) in
       if String.equal buffer magic then begin
         try
           let linear_unit_info = (input_value ic : linear_unit_info) in
           let last_label = (input_value ic : Cmm.label) in
           Cmm.reset ();
           Cmm.set_label last_label;
           let crc = (input_value ic : Digest.t) in
           linear_unit_info, crc
         with End_of_file | Failure _ -> raise (Error (Corrupted filename))
            | Error e -> raise (Error e)
       end
       else if String.sub buffer 0 9 = String.sub magic 0 9 then
         raise (Error (Wrong_version filename))
       else
         raise (Error (Wrong_format filename))
    )
    ~always:(fun () -> close_in ic)

(* Error report *)

open Format

let report_error ppf = function
  | Wrong_format filename ->
      fprintf ppf "Expected Linear format. Incompatible file %a"
        Location.print_filename filename
  | Wrong_version filename ->
      fprintf ppf
        "%a@ is not compatible with this version of OCaml"
        Location.print_filename filename
  | Corrupted filename ->
      fprintf ppf "Corrupted format@ %a"
        Location.print_filename filename
  | Marshal_failed filename ->
      fprintf ppf "Failed to marshal Linear to file@ %a"
        Location.print_filename filename

let () =
  Location.register_error_of_exn
    (function
      | Error err -> Some (Location.error_of_printer_file report_error err)
      | _ -> None
    )

************************************************************************
                                                                        
                                 OCaml                                  
                                                                        
                                                                        
     en Automatique.                                                    
                                                                        
   All rights reserved.  This file is distributed under the terms of    
   special exception on linking described in the file LICENSE.          
                                                                        
************************************************************************
 Error report 
                , projet Cristal , INRIA Rocquencourt           
                       , Jane Street Europe                     
    Copyright 1996 Institut National de Recherche en Informatique et     
    Copyright 2019 Jane Street Group LLC                                 
    the GNU Lesser General Public License version 2.1 , with the          

  Marshal and unmarshal a compilation unit in linear format
type linear_item_info =
  | Func of Linear.fundecl
  | Data of Cmm.data_item list

type linear_unit_info =
  {
    mutable unit : Compilation_unit.t;
    mutable items : linear_item_info list;
  }

type error =
  | Wrong_format of string
  | Wrong_version of string
  | Corrupted of string
  | Marshal_failed of string

exception Error of error

let save filename linear_unit_info =
  let ch = open_out_bin filename in
  Misc.try_finally (fun () ->
    output_string ch Config.linear_magic_number;
    output_value ch linear_unit_info;
  Saved because  and Emit depend on Cmm.label .
    output_value ch (Cmm.cur_label ());
  Compute digest of the contents and append it to the file .
    flush ch;
    let crc = Digest.file filename in
    output_value ch crc
  )
    ~always:(fun () -> close_out ch)
    ~exceptionally:(fun () -> raise (Error (Marshal_failed filename)))

let restore filename =
  let ic = open_in_bin filename in
  Misc.try_finally
    (fun () ->
       let magic = Config.linear_magic_number in
       let buffer = really_input_string ic (String.length magic) in
       if String.equal buffer magic then begin
         try
           let linear_unit_info = (input_value ic : linear_unit_info) in
           let last_label = (input_value ic : Cmm.label) in
           Cmm.reset ();
           Cmm.set_label last_label;
           let crc = (input_value ic : Digest.t) in
           linear_unit_info, crc
         with End_of_file | Failure _ -> raise (Error (Corrupted filename))
            | Error e -> raise (Error e)
       end
       else if String.sub buffer 0 9 = String.sub magic 0 9 then
         raise (Error (Wrong_version filename))
       else
         raise (Error (Wrong_format filename))
    )
    ~always:(fun () -> close_in ic)


open Format

let report_error ppf = function
  | Wrong_format filename ->
      fprintf ppf "Expected Linear format. Incompatible file %a"
        Location.print_filename filename
  | Wrong_version filename ->
      fprintf ppf
        "%a@ is not compatible with this version of OCaml"
        Location.print_filename filename
  | Corrupted filename ->
      fprintf ppf "Corrupted format@ %a"
        Location.print_filename filename
  | Marshal_failed filename ->
      fprintf ppf "Failed to marshal Linear to file@ %a"
        Location.print_filename filename

let () =
  Location.register_error_of_exn
    (function
      | Error err -> Some (Location.error_of_printer_file report_error err)
      | _ -> None
    )
