DB.ml

(* Copyright INRIA and Microsoft Corporation, 2008-2013. *)
(* DDMF is distributed under CeCILL-B license. *)

INCLUDE "preamble.ml"

(* Marshaling special functions and related types. *)

type marshaled_mon = {
  m_x_expon : Maple.cas_code ;
  m_ln_expon : Maple.cas_code ;
  m_coeff : Maple.cas_code ;
}

let marshal_mon m =
  let r : marshaled_mon = {
    m_x_expon = Maple.serialization_of_t m.SF.x_expon ;
    m_ln_expon = Maple.serialization_of_t m.SF.ln_expon ;
    m_coeff = Maple.serialization_of_t m.SF.coeff ;
  }
  in Marshal.to_string r []

let unmarshal_mon s =
  let r : marshaled_mon = Marshal.from_string s 0
  in {
    SF.x_expon = Maple.evaluator_symbolic r.m_x_expon ;
    SF.ln_expon = Maple.evaluator_symbolic r.m_ln_expon ;
    SF.coeff = Maple.evaluator_symbolic r.m_coeff ;
  }

type marshaled_ex = {
  m_sing_type : SF.singularity_type ;
  m_prefactor : Maple.cas_code ;
  m_transf : Maple.cas_code ;
  m_monomials : string list ;
}

let marshal_ex e =
  let r : marshaled_ex = {
    m_sing_type = e.SF.sing_type ;
    m_prefactor = Maple.serialization_of_t e.SF.prefactor ;
    m_transf = Maple.serialization_of_t e.SF.transf ;
    m_monomials = List.map marshal_mon e.SF.monomials ;
  }
  in Marshal.to_string r []

let unmarshal_ex s =
  let r : marshaled_ex = Marshal.from_string s 0
  in {
    SF.sing_type = r.m_sing_type ;
    SF.prefactor = Maple.evaluator_symbolic r.m_prefactor ;
    SF.transf = Maple.evaluator_symbolic r.m_transf ;
    SF.monomials = List.map unmarshal_mon r.m_monomials ;
  }

type marshaled_ic = {
  m_point : Maple.cas_code ;
  m_analytic : bool ;
  m_expansions : string list ;
}

let marshal_ic i =
  let r : marshaled_ic = {
    m_point = Maple.serialization_of_t i.SF.point ;
    m_analytic = i.SF.analytic ;
    m_expansions = List.map marshal_ex i.SF.expansions ;
  }
  in Marshal.to_string r []

let unmarshal_ic s =
  let r : marshaled_ic = Marshal.from_string s 0
  in {
    SF.point = Maple.evaluator_symbolic r.m_point ;
    SF.analytic = r.m_analytic ;
    SF.expansions = List.map unmarshal_ex r.m_expansions ;
  }

type marshaled_sf = {
  m_names_and_types : (Maple.cas_code * SF.arg_type) list ;
  m_rep : Maple.cas_code ;
  m_full_name : string ;
  m_lode : Maple.cas_code ;
  m_ics : (string * (string list)) list ;
  m_ode_id : string ;
}

let marshal_sf s =
  let r : marshaled_sf = {
    m_names_and_types =
      List.map
        (fun (m, t) -> Maple.serialization_of_t m, t)
        s.SF.names_and_types ;
    m_rep = Maple.serialization_of_t s.SF.rep ;
    m_full_name = s.SF.full_name ;
    m_lode = Maple.serialization_of_t s.SF.lode ;
    m_ics =
      List.map
        (fun (a, b) ->
          (Maple.serialization_of_t a,
           List.map marshal_ic b))
        s.SF.ics ;
    m_ode_id = s.SF.ode_id ;
  }
  in Marshal.to_string r []

let unmarshal_sf s =
  let r : marshaled_sf = Marshal.from_string s 0
  in {
    SF.names_and_types =
      List.map
        (fun (m, t) -> Maple.evaluator_symbolic m, t)
        r.m_names_and_types ;
    SF.rep = Maple.evaluator_symbolic r.m_rep ;
    SF.full_name = r.m_full_name ;
    SF.lode = Maple.evaluator_symbolic r.m_lode ;
    SF.ics =
      List.map
        (fun (a, b) ->
          (Maple.evaluator_symbolic a,
           List.map unmarshal_ic b))
        r.m_ics ;
    SF.ode_id = r.m_ode_id ;
  }


(* Database of special functions. *)

exception SFDatabaseCorrupted
exception UndefinedSF of string

let empty_sf_db () = DBLow.empty_sf_db ()

let sf_list () = DBLow.sf_list ()

let new_sf id sf = DBLow.new_sf id (marshal_sf sf)

let sf_of_id id =
  match DBLow.sf_of_id id with
  | [] -> raise (UndefinedSF id)
  | [ m_sf ] -> unmarshal_sf m_sf
  | _ -> raise SFDatabaseCorrupted


(* Marshaling functional equations. *)

type marshaled_eqn = {
  m_eqn_type : FEqn.eqn_type ;
  m_names_and_types : (Maple.cas_code * FEqn.arg_type) list ;
  m_eqn_name : string ;
  m_eqn : Maple.cas_code ;
  m_sol_ids : string list ;
}

let marshal_eqn o =
  let r : marshaled_eqn = {
    m_eqn_type = o.FEqn.eqn_type ;
    m_names_and_types =
      List.map
        (fun (m, t) -> Maple.serialization_of_t m, t)
        o.FEqn.names_and_types ;
    m_eqn_name = o.FEqn.eqn_name ;
    m_eqn = Maple.serialization_of_t o.FEqn.eqn ;
    m_sol_ids = o.FEqn.sol_ids ;
  }
  in Marshal.to_string r []

let unmarshal_eqn s =
  let r : marshaled_eqn = Marshal.from_string s 0
  in {
    FEqn.eqn_type = r.m_eqn_type ;
    FEqn.names_and_types =
      List.map
        (fun (m, t) -> Maple.evaluator_symbolic m, t)
        r.m_names_and_types ;
    FEqn.eqn_name = r.m_eqn_name ;
    FEqn.eqn = Maple.evaluator_symbolic r.m_eqn ;
    FEqn.sol_ids = r.m_sol_ids ;
  }


(* Database of functional equations. *)

exception DatabaseCorrupted
exception UndefinedFEqn of string

let empty_eqn_db () = DBLow.empty_eqn_db ()

let eqn_list eqn_typ = DBLow.eqn_list eqn_typ

let new_eqn id eqn = DBLow.new_eqn id (marshal_eqn eqn) eqn.FEqn.eqn_type

let eqn_of_id id =
  match DBLow.eqn_of_id id with
  | [] -> raise (UndefinedFEqn id)
  | [ m_eqn ] -> unmarshal_eqn m_eqn
  | _ -> raise DatabaseCorrupted


(* Marshaling sequences. *)

type marshaled_seq = {
  m_rep : any maple ;
  m_full_name : string ;
  m_ics : Seq.initial_condition list ;
  m_rec_id : string ;
  }

let marshal_seq s =
  let r : marshaled_seq = {
    m_rep = s.Seq.rep ;
    m_full_name = s.Seq.full_name ;
    m_ics = s.Seq.ics ;
    m_rec_id = s.Seq.rec_id ;
  }
  in Marshal.to_string r []

let unmarshal_seq s =
  let r : marshaled_seq = Marshal.from_string s 0
  in {
    Seq.rep = r.m_rep ;
    Seq.full_name = r.m_full_name ;
    Seq.ics = r.m_ics ;
    Seq.rec_id = r.m_rec_id ;
  }


(* Database of sequences. *)

exception UndefinedSeq of string

let empty_seq_db () = DBLow.empty_seq_db ()

let seq_list () = DBLow.seq_list ()

let new_seq id seq = DBLow.new_seq id (marshal_seq seq)

let seq_of_id id =
  match DBLow.seq_of_id id with
  | [] -> raise (UndefinedSeq id)
  | [ m_seq ] -> unmarshal_seq m_seq
  | _ -> raise DatabaseCorrupted

Generated by GNU Enscript 1.6.5.90.