compile.ml

(* Time-stamp: <modified the 18/01/2013 (at 15:59) by Erwan JAHIER> *)


open Lxm
open Errors
open AstV6
open AstCore

(* get the first package in the package/model list *)
let rec first_pack_in =
  function
    | (NSPack pi)::_ -> pi.it.pa_name
    | (NSModel _)::tail -> first_pack_in tail
    | [] -> raise (Global_error "No package has been provided")

let (doit : AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) = 
  fun srclist main_node ->

    let syntax_tab = AstTab.create srclist in
    (* Pour chaque package, on a un solveur de rfrences
       globales, pour les types, const et node :
       - les rfrences pointes (p::n) sont recherches
       directement dans la syntax_tab puisqu'il n'y a pas 
       d'ambiguit
       - les rfrences simples sont recherches :
       . dans le pack lui-mme
       . dans un des packs dclars "uses", avec
       priorit dans l'ordre
    *)
    let lic_tab = LicTab.create syntax_tab in
    Verbose.exe ~level:2 (fun () -> AstTab.dump syntax_tab);
    Ident.set_dft_pack_name (first_pack_in srclist);

    let lic_tab = match main_node with
      | None -> LicTab.compile_all lic_tab
      | Some main_node -> 
        if !Global.compile_all_items then
          LicTab.compile_all lic_tab
        else 
          LicTab.compile_node lic_tab main_node
    in
    let zelic = LicTab.to_lic_prg lic_tab in
    (* limination polymorphisme  surcharge *)
    let zelic = L2lRmPoly.doit zelic in
    (* alias des types array *)
(*     let zelic = L2lAliasType.doit zelic in *)
    let zelic = if not !Global.inline_iterator then zelic else
        (* Array and struct expansion: to do after polymorphism elimination *)
        L2lExpandMetaOp.doit zelic 
    in
    let zelic = 
      if 
           !Global.one_op_per_equation 
        || !Global.expand_nodes (* expand performs no fixpoint, so it will work
                                   only if we have one op per equation...*)
      then 
        (* Split des equations (1 eq = 1 op) *)
        L2lSplit.doit zelic 
      else 
        zelic
    in
    let zelic = if not !Global.expand_nodes then zelic else 
        L2lExpandNodes.doit zelic 
    in
    let zelic = if not !Global.expand_structs then zelic else
        (* Array and struct expansion: to do after polymorphism elimination *)
        L2lExpandArrays.doit zelic 
    in    
    L2lCheckOutputs.doit zelic;
    zelic