ocamlspot / spotfile.ml

camlspotter fb1f10e 

camlspotter d0e75b7 
camlspotter fb1f10e 


camlspotter d0e75b7 
camlspotter fb1f10e 













camlspotter 1fd4dcd 
camlspotter 141d7f7 


camlspotter bcf9a42 
camlspotter b3c91e2 
camlspotter 141d7f7 
camlspotter fb1f10e 
camlspotter 141d7f7 
camlspotter a3b5276 
camlspotter 8a464cf 
camlspotter a3b5276 
camlspotter bd376ab 
camlspotter 99c7d1a 












camlspotter fb1f10e 
camlspotter 141d7f7 
camlspotter bd376ab 
camlspotter 141d7f7 






camlspotter bd376ab 
camlspotter 141d7f7 
camlspotter bd376ab 
camlspotter 141d7f7 

camlspotter bd376ab 


camlspotter fb1f10e 
camlspotter 141d7f7 
camlspotter fb1f10e 
camlspotter 141d7f7 


camlspotter bd376ab 
camlspotter 2c7e1b1 
camlspotter fb1f10e 
camlspotter 141d7f7 
camlspotter fb1f10e 
camlspotter 141d7f7 


camlspotter a290ebb 
camlspotter bd376ab 







camlspotter 141d7f7 

camlspotter bd376ab 
camlspotter fb1f10e 
camlspotter 141d7f7 


camlspotter bd376ab 
camlspotter 99c7d1a 



camlspotter 141d7f7 

















camlspotter 2c7e1b1 
camlspotter 141d7f7 


camlspotter 2c7e1b1 
camlspotter 141d7f7 






camlspotter 313e8d6 


















































camlspotter 141d7f7 


camlspotter 313e8d6 











camlspotter 141d7f7 
camlspotter bcf9a42 




camlspotter 141d7f7 
camlspotter bcf9a42 
camlspotter 141d7f7 

camlspotter bcf9a42 
camlspotter 141d7f7 






camlspotter fb1f10e 
camlspotter 141d7f7 




camlspotter 06537df 
camlspotter 8a464cf 

camlspotter 141d7f7 
camlspotter 8a464cf 
camlspotter 141d7f7 

camlspotter 8a464cf 

camlspotter 141d7f7 
camlspotter 8a464cf 
camlspotter 141d7f7 
























camlspotter 88b2880 

camlspotter 141d7f7 







camlspotter 8a464cf 
camlspotter 141d7f7 
camlspotter 8a464cf 
camlspotter 141d7f7 
camlspotter 8a464cf 






camlspotter 141d7f7 

camlspotter fb1f10e 
camlspotter bcf9a42 
camlspotter 141d7f7 
camlspotter bcf9a42 
camlspotter 141d7f7 
camlspotter 06537df 
camlspotter fb1f10e 
camlspotter 141d7f7 
camlspotter fb1f10e 
camlspotter 141d7f7 


camlspotter 06537df 
camlspotter 141d7f7 
camlspotter fb1f10e 
camlspotter 141d7f7 
(***********************************************************************)
(*                                                                     *)
(*                            OCamlSpotter                             *)
(*                                                                     *)
(*                             Jun FURUSE                              *)
(*                                                                     *)
(*   Copyright 2008-2012 Jun Furuse. All rights reserved.              *)
(*   This file is distributed under the terms of the GNU Library       *)
(*   General Public License, with the special exception on linking     *)
(*   described in file LICENSE.                                        *)
(*                                                                     *)
(***********************************************************************)

open Format
open Utils

(* Keep the original modules *)
module Ident0 = Ident

open Spot
open Spoteval

module Load : sig
  exception Old_cmt of string (* cmt *) * string (* source *)
  val load : load_paths:string list -> string -> Unit.t
  val load_module : ?spit:bool -> cwd:string -> load_paths:string list -> string -> Unit.t
  val load_directly_with_cache : string -> Unit.t
end = struct

  let check_time_stamp ~cmt source =
    (* CR jfuruse: aaa.mll creates cmt with aaa.ml as source, but
       aaa.ml is often removed by the build system.
    *)
    let stat_cmt = try Unix.stat cmt with _ -> assert false in
    try
      let stat_source = Unix.stat source in
        (* Needs = : for packed modules, .cmt and the source .cmo are written 
           almost at the same moment. *)
      stat_cmt.Unix.st_mtime >= stat_source.Unix.st_mtime
    with
    | Unix.Unix_error(_, "stat", _) ->
        (* CR jfuruse: Camlp4.cmt created from Camlp4.cmx but Camlp4.cmx
           is not installed!!! In such a case, we cannot check the time
           stamp check... (still we can try against Camlp4.cmi installed)
        *)
        eprintf "Warning: source %s does not exist. Time stamp check was skipped.@." source;
        true

  let find_alternative_source ~cmt source =
      (* if [source] is not found, we try finding files with the same basename in
         - the directory of [cmt]
         - the directory of [cmt] points to (if [cmt] is symlink)
       *)
    let source_base = Filename.basename source in
    let source_dirs =
        Filename.dirname cmt ::
        begin 
          let stat_cmt = try Unix.lstat cmt with _ -> assert false in
          if stat_cmt.Unix.st_kind = Unix.S_LNK then
            [ Filename.dirname (try Unix.readlink cmt with _ -> assert false) ]
          else []
        end
    in
    List.find Sys.file_exists 
      (List.map (fun d -> d ^/ source_base) source_dirs)

  let load_cmt_file file = snd (Cmt_format.read file)

  let load_directly path : Unit.t =
    Debug.format "cmt loading from %s@." path;
    match load_cmt_file path with
    | Some cmt -> Spot.Unit.of_file (Spot.File.of_cmt path cmt)
    | None -> failwithf "load_directly failed: %s" path

  exception Old_cmt of string (* cmt *) * string (* source *)

  (* CR jfuruse: exception *)
  (* CRv2 jfuruse: add and check cache time stamp *)
  let load_directly_with_cache : string -> Unit.t = 
    Hashtbl.memoize (Hashtbl.create 17) (fun path ->
      try
        let file = load_directly path in
        if not (check_time_stamp ~cmt:path file.Unit.path) then 
          if Spotconfig.strict_time_stamp then 
            raise (Old_cmt (path, file.Unit.path))
          else
            eprintf "Warning: source %s is newer than the cmt@." file.Unit.path;
        file
      with
      | Not_found ->
          failwithf "failed to find cmt file %s" path)

  let find_in_path load_paths body ext =
    let body_ext = body ^ ext in
    let find_in_path load_paths name = 
      Debug.format "@[<2>find_in_path: searching %s in@ pwd=%s@ paths=[@[%a@]]@]@." 
        name
        (Sys.getcwd ())
        (Format.list "; " (fun ppf x -> fprintf ppf "%S" x)) 
        load_paths;
      try Misc.find_in_path load_paths name with Not_found ->
        Misc.find_in_path_uncap load_paths name
    in
    try find_in_path load_paths body_ext with Not_found ->
    (* We do not give up yet.
       .cmt file is not found, 
       but we still find a .cmi which is sym-linked to the original directory with .cmt
    *)
    let cminame = body ^ ".cmi" in
      try
      let cmipath = find_in_path load_paths cminame in
      let stat = Unix.lstat cmipath in
      if stat.Unix.st_kind = Unix.S_LNK then begin
        let cmipath = Filename.dirname cmipath ^/ Unix.readlink cmipath in
        let cmtpath = Filename.chop_extension cmipath ^ ext in
        if Sys.file_exists cmtpath then begin
          Debug.format "Found an alternative %s: %s@." ext cmtpath;
            cmtpath 
          end else failwithf "cmt file not found: %s, neither in %s" body_ext cmtpath
        end else raise Not_found
      with
      | (Failure _ as e) -> raise e
      | _ -> failwithf "cmt file not found: %s" body_ext
    

  let load ~load_paths cmtname : Unit.t =
    let body, ext = Filename.split_extension cmtname in
    let path = find_in_path load_paths body ext in
    load_directly_with_cache path

  (* ocamlbuild tweak *)
  (* for  /.../a/b/c/x.ml
     if   /.../a/_build exists
     then look for
          /.../a/_build/b/c/x.cm*
  *)
  (* seek ocamlbuild _build destination directory *)      
  let ocamlbuild_path_tweak cmtname =
    if Filename.is_relative cmtname then None
    else
      let basename = Filename.basename cmtname in
      let dirname = Filename.dirname cmtname in
      let rec loop postfix dir = 
        let dir_build = dir ^/ "_build" in
        if Unix.is_dir dir_build then dir_build ^/ postfix
        else 
          if dir = "/" then raise Exit
          else loop (Filename.basename dir ^/ postfix) (Filename.dirname dir)
      in
      try 
        let cmtname = loop "" dirname ^/ basename in
        Debug.format "Trying ocamlbuild destination %s@." cmtname;
        Some cmtname
      with Exit -> None

  (* .ocamlspot file tweak *)        
  let dot_ocamlspot_tweak cmtname = 
    if Filename.is_relative cmtname then None
    else
      Option.bind (Dotfile.find_and_load (Filename.dirname cmtname)) 
        (fun (found_dir, dotfile) ->
          Option.map dotfile.Dotfile.build_dir ~f:(fun build_dir ->
            let length_found_dir = String.length found_dir in
            let found_dir' = 
              String.sub cmtname 0 length_found_dir
            in
            let rel_cmtname =
              String.sub cmtname 
                (length_found_dir + 1)
                (String.length cmtname - length_found_dir - 1)
            in
            assert (found_dir = found_dir');
            let dir = 
              if Filename.is_relative build_dir then found_dir ^/ build_dir
              else build_dir
            in
            let cmtname = dir ^/ rel_cmtname in
            Debug.format "Trying .ocamlspot destination %s@." cmtname;
            cmtname
          ))

  let load ~load_paths cmtname : Unit.t =
    try load ~load_paths cmtname with
    | e -> 
        let load_alternative f =
          match f cmtname with
          | None -> None
          | Some cmtname ->
              try Some (load ~load_paths cmtname) with _ -> None
        in
        match load_alternative dot_ocamlspot_tweak with
        | Some v -> v
        | None -> 
            match load_alternative ocamlbuild_path_tweak with
            | Some v -> v
            | None -> raise e

  let with_cwd cwd f = 
    let d = Sys.getcwd () in
    protect ~f:(fun () -> Sys.chdir cwd; f ()) () 
      ~finally: (fun _ -> Sys.chdir d)

  (* CR jfuruse: searching algorithm must be reconsidered *)        
  let load_module ?(spit=false) ~cwd ~load_paths name =
    let cmtname = name ^ if spit then ".cmti" else ".cmt" in
    try
      with_cwd cwd (fun () -> load ~load_paths cmtname)
    with
    | Failure s ->
        let spitname = name ^ if spit then ".cmt" else ".cmti" in
        Format.printf "%s load failed. Try to load %s@."
          cmtname spitname;
        try
          load ~load_paths spitname
        with
        | Failure s' -> failwithf "%s\n%s" s s'
end

include Load

let initial_env file =
  { Env.path   = file.Unit.path;
    cwd        = file.Unit.builddir;
    load_paths = file.Unit.loadpath;
    binding    = Binding.predef }

let invalid_env file =
  { Env.path   = file.Unit.path;
    cwd        = file.Unit.builddir;
    load_paths = file.Unit.loadpath;
    binding    = Binding.invalid }
    
type result =
    | File_itself
    | Found_at of Region.t
    | Predefined

let find_path_in_flat file path : PIdent.t * result =
  let env = 
    let env = invalid_env file in
    let str = Eval.structure env !!(file.Unit.flat) in
    Binding.set env.Env.binding str; (* dirty hack *)
    env
  in
  let find_loc pid =
    match  pid.PIdent.path with
    | "" -> Predefined
    | path ->
        (* CR jfuruse: loading twice... *)
        Debug.format "Finding %a@." PIdent.format pid;
        let file = Load.load ~load_paths:[] (Cmt.of_path path) in
        match pid.PIdent.ident with
        | None -> File_itself (* the whole file *)
        | Some id -> 
            Found_at begin try
              Hashtbl.find !!(file.Unit.id_def_regions) id
            with
            | Not_found ->
                eprintf "Error: find location of id %a failed@."
                  PIdent.format pid;
                raise Not_found
            end
  in
  
  let eval_and_find path =
    (* we need evaluate the path *)
    let module V = Value in
    let v = !!(Eval.find_path env path) in
    Debug.format "Value=%a@." V.Format.t v;
    match v with
    | V.Ident id                      -> id, find_loc id
    | V.Parameter id                  -> id, find_loc id
    | V.Structure (id, _, _)          -> id, find_loc id
    | V.Closure (id, _, _, _, _)      -> id, find_loc id
    | V.Error (Failure _ as e)        -> raise e
    | V.Error (Load.Old_cmt _ as exn) -> raise exn
    | V.Error exn                     -> raise exn
  in
  eval_and_find path

let str_of_global_ident ~cwd ~load_paths id =
  assert (Ident.global id);
  let file = Load.load_module ~spit:Spotconfig.print_interface ~cwd ~load_paths (Ident0.name id) in
  file.Unit.path,
  Eval.structure (initial_env file) file.Unit.top

let _ = Eval.str_of_global_ident := str_of_global_ident

let eval_packed env file =
  let f = Load.load ~load_paths:[""] (Cmt.of_path (env.Env.cwd ^/ file)) in
  Value.Structure ({ PIdent.path = f.Unit.path; ident = None },
                  Eval.structure (initial_env f) f.Unit.top,
                  None (* packed has no .mli *))

let _ = Eval.packed := eval_packed
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.