Skip to content
Snippets Groups Projects
compile.ml 1.87 KiB
(** Time-stamp: <modified the 23/01/2009 (at 09:28) by Erwan Jahier> *)


open Lxm
open Errors
open SyntaxTree
open SyntaxTreeCore

(* 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 : SyntaxTree.pack_or_model list -> Ident.idref option -> unit) = 
  fun srclist main_node ->

  let syntax_tab = SyntaxTab.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 lzcomp = LazyCompiler.create syntax_tab in
    if Verbose.get_level () > 2 then SyntaxTab.dump syntax_tab;
    Ident.set_dft_pack_name (first_pack_in srclist);

    match main_node with
      | None -> LazyCompiler.compile_all lzcomp
      | Some main_node -> 
          (* la cle "absolue" du main node (pas d'args statiques) *)
          let main_node_key = 
            Eff.make_simple_node_key (Ident.long_of_idref main_node) 
          in
            Verbose.printf 
              "-- MAIN NODE: \"%s\"\n" 
              (LicDump.string_of_node_key_rec main_node_key);
            
            if !Global.compile_all_items then
              LazyCompiler.compile_all lzcomp
            else
              ignore(LazyCompiler.node_check lzcomp main_node_key 
                       (match Ident.pack_of_idref main_node with 
                          | None -> Lxm.dummy "" 
                          | Some pn  -> Lxm.dummy (Ident.pack_name_to_string pn)))