camlspotter avatar camlspotter committed 7ac921f Merge

merge with +win branch

Comments (0)

Files changed (15)

 command.cmx : command.cmi
 compdir.cmo : utils.cmi filepath.cmi dotfile.cmi compdir.cmi
 compdir.cmx : utils.cmx filepath.cmx dotfile.cmx compdir.cmi
+copiedfilename.cmo :
+copiedfilename.cmx :
 dotfile.cmo : utils.cmi dotfile.cmi
 dotfile.cmx : utils.cmx dotfile.cmi
 ext.cmo : xprinttyp.cmi xpath.cmi xlongident.cmi xident.cmi
 ext.cmx : xprinttyp.cmx xpath.cmx xlongident.cmx xident.cmx
 fileident.cmo : utils.cmi fileident.cmi
 fileident.cmx : utils.cmx fileident.cmi
-filepath.cmo : utils.cmi filepath.cmi
-filepath.cmx : utils.cmx filepath.cmi
+filepath.cmo : utils.cmi copiedfilename.cmo filepath.cmi
+filepath.cmx : utils.cmx copiedfilename.cmx filepath.cmi
 locident.cmo : locident.cmi
 locident.cmx : locident.cmi
 name.cmo : name.cmi
 name.cmx : name.cmi
-ocamlspot.cmo : utils.cmi typeexpand.cmi spotfile.cmi spoteval.cmi \
+ocamlspot.cmo : utils.cmi typeexpand.cmi test.cmo spotfile.cmi spoteval.cmi \
     spotconfig.cmi spot.cmi filepath.cmi ext.cmo compdir.cmi command.cmi \
     cmt.cmi
-ocamlspot.cmx : utils.cmx typeexpand.cmx spotfile.cmx spoteval.cmx \
+ocamlspot.cmx : utils.cmx typeexpand.cmx test.cmx spotfile.cmx spoteval.cmx \
     spotconfig.cmx spot.cmx filepath.cmx ext.cmx compdir.cmx command.cmx \
     cmt.cmx
 pathreparse.cmo : utils.cmi spot.cmi locident.cmi ext.cmo pathreparse.cmi
 pathreparse.cmx : utils.cmx spot.cmx locident.cmx ext.cmx pathreparse.cmi
-record.cmo :
-record.cmx :
 spot.cmo : utils.cmi treeset.cmi ext.cmo cmt.cmi checksum.cmo spot.cmi
 spot.cmx : utils.cmx treeset.cmx ext.cmx cmt.cmx checksum.cmx spot.cmi
 spotconfig.cmo : utils.cmi spot.cmi ext.cmo spotconfig.cmi
     cmt.cmi spotfile.cmi
 spotfile.cmx : utils.cmx spoteval.cmx spotconfig.cmx spot.cmx dotfile.cmx \
     cmt.cmx spotfile.cmi
+test.cmo : utils.cmi filepath.cmi
+test.cmx : utils.cmx filepath.cmx
 treeset.cmo : xset.cmi treeset.cmi
 treeset.cmx : xset.cmx treeset.cmi
 typeFix.cmo : utils.cmi name.cmi typeFix.cmi
 # Requires unix!
 COMPFLAGS= -g $(INCLUDES_DEP) -I +unix
 
-MODULES= utils checksum fileident filepath dotfile compdir xset treeset command typeexpand \
-	xlongident name xident xpath locident typeFix xprinttyp ext cmt spot spoteval spotconfig_intf spotconfig spotfile ocamlspot # pathreparse 
+MODULES= utils checksum fileident copiedfilename filepath dotfile compdir xset treeset command typeexpand \
+	xlongident name xident xpath locident typeFix xprinttyp ext cmt spot spoteval spotconfig_intf spotconfig spotfile test ocamlspot # pathreparse 
 
 OBJS=		$(addsuffix .cmo, $(MODULES))
 
   let module FP = Filepath in
   (* CR jfuruse: we should create a function for this *)
   let path = if Filename.is_relative path then Unix.getcwd () ^/ path else path in
-  let fp = FP.of_string path in
+  let fp = FP.of_string FP.os path in
   match FP.dirbase fp with
   | _, None -> failwithf "Error: %s is not a normal file path" path
   | dir, Some base ->
 let rec find_dot_ocamlspot fp = 
   let open FP in
   match
-    if Unix.is_dir (FP.to_string (fp ^/ "_build")) then Some (fp, "_build")
+    if Unix.is_dir FP.(to_string (fp ^/ "_build")) then Some (fp, "_build")
     else
       let dot_ocamlspot = fp ^/ ".ocamlspot" in
       if Sys.file_exists (FP.to_string dot_ocamlspot) then
     match find_dot_ocamlspot fp0 with
     | None -> fp0
     | Some (dir, mv) ->
-        match FP.contains_abs dir fp0 with
+        match FP.is_prefix dir fp0 with
         | None -> fp0
         | Some postfixes ->
-            match FP.contains_abs (FP.(^/) dir mv) fp0 with
+            match FP.(is_prefix (dir ^/ mv) fp0) with
             | Some _ -> fp0 (* already in the comp dir *)
-            | None -> 
-                (* CR jfuruse: inefficient *)
-                FP.of_string (Filename.concats (FP.to_string dir :: mv :: postfixes))
+            | None -> FP.concats dir (mv :: postfixes)
 
 let comp_dir x =
   let y = comp_dir x in
-  if not (FP.equal x y) then
+  if x <> y then
     Format.eprintf "comp_dir: %s => %s@." (FP.to_string x) (FP.to_string y);
   y
 
     match find_dot_ocamlspot fp0 with
     | None -> fp0
     | Some (dir, mv) ->
-        match FP.contains_abs (FP.(^/) dir mv) fp0 with
+        match FP.(is_prefix (dir ^/ mv) fp0) with
         | None -> fp0
-        | Some postfixes -> 
-            (* CR jfuruse: inefficient *)
-            FP.of_string (Filename.concats (FP.to_string dir :: postfixes))
+        | Some postfixes -> FP.concats dir postfixes
 
 let src_file x =
   let y = src_file x in
-  if not (FP.equal x y) then
+  if x <> y then
     Format.eprintf "src_file: %s => %s@." (FP.to_string x) (FP.to_string y);
   y
 

copiedfilename.ml

+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Xavier Leroy and Damien Doligez, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  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.     *)
+(*                                                                     *)
+(***********************************************************************)
+
+let generic_quote quotequote s =
+  let l = String.length s in
+  let b = Buffer.create (l + 20) in
+  Buffer.add_char b '\'';
+  for i = 0 to l - 1 do
+    if s.[i] = '\''
+    then Buffer.add_string b quotequote
+    else Buffer.add_char b  s.[i]
+  done;
+  Buffer.add_char b '\'';
+  Buffer.contents b
+
+(* This function implements the Open Group specification found here:
+  [[1]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/basename.html
+  In step 1 of [[1]], we choose to return "." for empty input.
+    (for compatibility with previous versions of OCaml)
+  In step 2, we choose to process "//" normally.
+  Step 6 is not implemented: we consider that the [suffix] operand is
+    always absent.  Suffixes are handled by [chop_suffix] and [chop_extension].
+*)
+let generic_basename is_dir_sep current_dir_name name =
+  let rec find_end n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then find_end (n - 1)
+    else find_beg n (n + 1)
+  and find_beg n p =
+    if n < 0 then String.sub name 0 p
+    else if is_dir_sep name n then String.sub name (n + 1) (p - n - 1)
+    else find_beg (n - 1) p
+  in
+  if name = ""
+  then current_dir_name
+  else find_end (String.length name - 1)
+
+(* This function implements the Open Group specification found here:
+  [[2]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/dirname.html
+  In step 6 of [[2]], we choose to process "//" normally.
+*)
+let generic_dirname is_dir_sep current_dir_name name =
+  let rec trailing_sep n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then trailing_sep (n - 1)
+    else base n
+  and base n =
+    if n < 0 then current_dir_name
+    else if is_dir_sep name n then intermediate_sep n
+    else base (n - 1)
+  and intermediate_sep n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then intermediate_sep (n - 1)
+    else String.sub name 0 (n + 1)
+  in
+  if name = ""
+  then current_dir_name
+  else trailing_sep (String.length name - 1)
+
+module Unix = struct
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let dir_sep = "/"
+  let is_dir_sep s i = s.[i] = '/'
+  let is_relative n = String.length n < 1 || n.[0] <> '/';;
+  let is_implicit n =
+    is_relative n
+    && (String.length n < 2 || String.sub n 0 2 <> "./")
+    && (String.length n < 3 || String.sub n 0 3 <> "../")
+  let check_suffix name suff =
+    String.length name >= String.length suff &&
+    String.sub name (String.length name - String.length suff)
+                    (String.length suff) = suff
+  let temp_dir_name =
+    try Sys.getenv "TMPDIR" with Not_found -> "/tmp"
+  let quote = generic_quote "'\\''"
+  let basename = generic_basename is_dir_sep current_dir_name
+  let dirname = generic_dirname is_dir_sep current_dir_name
+end
+
+module Win32 = struct
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let dir_sep = "\\"
+  let is_dir_sep s i = let c = s.[i] in c = '/' || c = '\\' || c = ':'
+  let is_relative n =
+    (String.length n < 1 || n.[0] <> '/')
+    && (String.length n < 1 || n.[0] <> '\\')
+    && (String.length n < 2 || n.[1] <> ':')
+  let is_implicit n =
+    is_relative n
+    && (String.length n < 2 || String.sub n 0 2 <> "./")
+    && (String.length n < 2 || String.sub n 0 2 <> ".\\")
+    && (String.length n < 3 || String.sub n 0 3 <> "../")
+    && (String.length n < 3 || String.sub n 0 3 <> "..\\")
+  let check_suffix name suff =
+   String.length name >= String.length suff &&
+   (let s = String.sub name (String.length name - String.length suff)
+                            (String.length suff) in
+    String.lowercase s = String.lowercase suff)
+  let temp_dir_name =
+    try Sys.getenv "TEMP" with Not_found -> "."
+  let quote s =
+    let l = String.length s in
+    let b = Buffer.create (l + 20) in
+    Buffer.add_char b '\"';
+    let rec loop i =
+      if i = l then Buffer.add_char b '\"' else
+      match s.[i] with
+      | '\"' -> loop_bs 0 i;
+      | '\\' -> loop_bs 0 i;
+      | c    -> Buffer.add_char b c; loop (i+1);
+    and loop_bs n i =
+      if i = l then begin
+        Buffer.add_char b '\"';
+        add_bs n;
+      end else begin
+        match s.[i] with
+        | '\"' -> add_bs (2*n+1); Buffer.add_char b '\"'; loop (i+1);
+        | '\\' -> loop_bs (n+1) (i+1);
+        | _c   -> add_bs n; loop i
+      end
+    and add_bs n = for _j = 1 to n do Buffer.add_char b '\\'; done
+    in
+    loop 0;
+    Buffer.contents b
+  let has_drive s =
+    let is_letter = function
+      | 'A' .. 'Z' | 'a' .. 'z' -> true
+      | _ -> false
+    in
+    String.length s >= 2 && is_letter s.[0] && s.[1] = ':'
+  let drive_and_path s =
+    if has_drive s
+    then (String.sub s 0 2, String.sub s 2 (String.length s - 2))
+    else ("", s)
+  let dirname s =
+    let (drive, path) = drive_and_path s in
+    let dir = generic_dirname is_dir_sep current_dir_name path in
+    drive ^ dir
+  let basename s =
+    let (_drive, path) = drive_and_path s in
+    generic_basename is_dir_sep current_dir_name path
+end
+
+module Cygwin = struct
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let dir_sep = "/"
+  let is_dir_sep = Win32.is_dir_sep
+  let is_relative = Win32.is_relative
+  let is_implicit = Win32.is_implicit
+  let check_suffix = Win32.check_suffix
+  let temp_dir_name = Unix.temp_dir_name
+  let quote = Unix.quote
+  let basename = generic_basename is_dir_sep current_dir_name
+  let dirname = generic_dirname is_dir_sep current_dir_name
+end
+
+let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep,
+     is_relative, is_implicit, check_suffix, temp_dir_name, quote, basename,
+     dirname) =
+  match Sys.os_type with
+    "Unix" ->
+      (Unix.current_dir_name, Unix.parent_dir_name, Unix.dir_sep,
+       Unix.is_dir_sep,
+       Unix.is_relative, Unix.is_implicit, Unix.check_suffix,
+       Unix.temp_dir_name, Unix.quote, Unix.basename, Unix.dirname)
+  | "Win32" ->
+      (Win32.current_dir_name, Win32.parent_dir_name, Win32.dir_sep,
+       Win32.is_dir_sep,
+       Win32.is_relative, Win32.is_implicit, Win32.check_suffix,
+       Win32.temp_dir_name, Win32.quote, Win32.basename, Win32.dirname)
+  | "Cygwin" ->
+      (Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.dir_sep,
+       Cygwin.is_dir_sep,
+       Cygwin.is_relative, Cygwin.is_implicit, Cygwin.check_suffix,
+       Cygwin.temp_dir_name, Cygwin.quote, Cygwin.basename, Cygwin.dirname)
+  | _ -> assert false
+
+let concat dirname filename =
+  let l = String.length dirname in
+  if l = 0 || is_dir_sep dirname (l-1)
+  then dirname ^ filename
+  else dirname ^ dir_sep ^ filename
+
+let chop_suffix name suff =
+  let n = String.length name - String.length suff in
+  if n < 0 then invalid_arg "Filename.chop_suffix" else String.sub name 0 n
+
+let chop_extension name =
+  let rec search_dot i =
+    if i < 0 || is_dir_sep name i then invalid_arg "Filename.chop_extension"
+    else if name.[i] = '.' then String.sub name 0 i
+    else search_dot (i - 1) in
+  search_dot (String.length name - 1)
+
+external open_desc: string -> open_flag list -> int -> int = "caml_sys_open"
+external close_desc: int -> unit = "caml_sys_close"
+
+let prng = lazy(Random.State.make_self_init ());;
+
+let temp_file_name temp_dir prefix suffix =
+  let rnd = (Random.State.bits (Lazy.force prng)) land 0xFFFFFF in
+  concat temp_dir (Printf.sprintf "%s%06x%s" prefix rnd suffix)
+;;
+
+let current_temp_dir_name = ref temp_dir_name
+
+let set_temp_dir_name s = current_temp_dir_name := s
+let get_temp_dir_name () = !current_temp_dir_name
+
+let temp_file ?(temp_dir = !current_temp_dir_name) prefix suffix =
+  let rec try_name counter =
+    let name = temp_file_name temp_dir prefix suffix in
+    try
+      close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o600);
+      name
+    with Sys_error _ as e ->
+      if counter >= 1000 then raise e else try_name (counter + 1)
+  in try_name 0
+
+let open_temp_file ?(mode = [Open_text]) ?(temp_dir = !current_temp_dir_name)
+                   prefix suffix =
+  let rec try_name counter =
+    let name = temp_file_name temp_dir prefix suffix in
+    try
+      (name,
+       open_out_gen (Open_wronly::Open_creat::Open_excl::mode) 0o600 name)
+    with Sys_error _ as e ->
+      if counter >= 1000 then raise e else try_name (counter + 1)
+  in try_name 0
 let name = ".ocamlspot"
 
 let rec find absdir =
+prerr_endline absdir;
   let path = absdir ^/ name in
   if Sys.file_exists path then Some (absdir, path)
   else if absdir = "/" then None
 
 open Utils
 
-module F = Filename
+module Filename = Copiedfilename
 
-let get_component : string -> string = 
-  Hashtbl.memoize (Hashtbl.create 1023) (fun x -> x)
+module type Filename = sig
+  val current_dir_name : string
+  val parent_dir_name : string
+  val dir_sep : string
+  val is_dir_sep : string -> int -> bool
+  val is_relative : string -> bool
+  val is_implicit : string -> bool
+  val check_suffix : string -> string -> bool
+  val temp_dir_name : string
+  val quote : string -> string
+  val basename : string -> string
+  val dirname : string -> string
 
-let dotdot = get_component ".."
+  val has_drive : string -> bool
+  val drive_and_path : string -> string * string
 
-let rec split st path = 
-  let dir  = F.dirname  path in
-  let base = F.basename path in
-  let st = 
-    let base = 
-      if base = ""
-      || base = F.current_dir_name 
-      || base = F.dir_sep || base = "/" then ""
-      else base
+  val normalize_drive : string -> string
+  val is_network_drive : string -> bool
+end
+
+module Unix : Filename = struct
+  include Filename.Unix
+  let has_drive _ = false
+  let drive_and_path s = "", s
+  let normalize_drive s = s
+  let is_network_drive _ = false
+end
+
+module Win32 : Filename = struct
+  include Filename.Win32
+    
+  (* We think network drives too *)
+  (* CR jfuruse: it returns true even for "///" *)
+  let has_drive s =
+    has_drive s 
+    || match String.sub' s 0 2 with
+      | "//" | "\\\\" -> true
+      | _ -> false
+
+  let drive_and_path s = 
+    match drive_and_path s with
+    | "", s ->
+        begin match String.sub' s 0 2 with
+        | ("//" | "\\\\" as p) -> p, String.sub s 2 (String.length s - 2)
+        | _ -> "", s
+        end
+    | res -> res
+
+  let normalize_drive s = String.replace_chars '/' '\\' (String.uppercase s)
+
+  let is_network_drive = function
+    | "//" | "\\\\" -> true
+    | _ -> false
+end
+
+module Cygwin : Filename = struct
+  include Filename.Cygwin
+  let has_drive = Win32.has_drive
+  let drive_and_path = Win32.drive_and_path
+  let normalize_drive s = String.replace_chars '\\' '/' (String.lowercase s)
+  let is_network_drive = Win32.is_network_drive
+end
+
+module Make(F : Filename) = struct
+  class c = object
+    method current = F.current_dir_name
+    method parent = F.parent_dir_name
+    method sep = F.dir_sep
+    method is_relative = F.is_relative
+    method is_absolute x = not (F.is_relative x)
+    method check_suffix = F.check_suffix
+    method dir_and_base s = F.dirname s, F.basename s
+    method temp_dir = F.temp_dir_name
+    method quote = F.quote
+    method drive_and_path = F.drive_and_path
+    method normalize_drive = F.normalize_drive
+    method is_network_drive = F.is_network_drive
+    method is_dir_sep = F.is_dir_sep
+  end
+end
+
+module MakeUnix = Make(Unix)
+
+type op = MakeUnix.c
+
+let unix   = let module M = Make(Unix)   in new M.c
+let win32  = let module M = Make(Win32)  in new M.c
+let cygwin = let module M = Make(Cygwin) in new M.c
+
+type os = 
+  | Unix (** We love *)
+  | Win32 (** We hate *)
+  | Cygwin (** a failed effort of reconcillation *)
+
+let of_os = function
+  | Unix -> unix
+  | Win32 -> win32
+  | Cygwin -> cygwin
+
+let os = match Sys.os_type with
+  | "Unix" -> Unix
+  | "Win32" -> Win32
+  | "Cygwin" -> Cygwin
+  | _ -> assert false
+
+type t = { 
+  os : os;
+  op : op;
+  drive : string option; (** Some "C:",  Some "\\\\" or Some "//" *)
+  abs : bool;
+  revs : string list; (** reversed directory components: a/b/c => ["a"; "b"; "c"] *)
+  normalized : bool;
+}
+
+let of_string os s =
+  let f = of_os os in
+  let drive, p = f#drive_and_path s in
+  let drive = if drive = "" then None else Some drive in
+  let abs = match drive with
+    | None -> f#is_absolute p 
+    | Some d when f#is_network_drive d -> true
+    | _ -> f#is_absolute p 
+  in
+  let rec splits st s =
+    let d, b = f#dir_and_base s in
+    if f#is_dir_sep d 0 && f#is_dir_sep b 0 then
+      (* In Unix at least, it means [s] is ["/"] or ["////"]. *)
+      st
+    else
+      if s = d then s :: st
+      else splits (b::st) d
+  in
+  let revs = List.rev (splits [] p) in
+  { os; 
+    op = f;
+    drive;
+    abs;
+    revs;
+    normalized = false }
+  
+let normalize t =
+  if t.normalized then t
+  else
+    let f = t.op in
+    let drive = match t.drive with
+      | None -> None
+      | Some d -> Some (f#normalize_drive d)
     in
-    get_component base :: st
+    (* xxx/./yyy => xxx/yyy
+       xxx/a/../yyy => xxx/yyy
+       /../../ => /../../
+    *)
+    let rec normalize_rev = function
+      | [] -> []
+      | x::xs when x = f#current -> normalize_rev xs
+      | x::xs when x = f#parent ->
+          let ys = normalize_rev xs in
+          begin match ys with
+          | [] when t.abs -> [] (* /.. => / *)
+          | [] -> [x] (* .. => .. *)
+          | z::_ when z = f#parent -> x::ys (* xxx/../.. => xxx/../.. *)
+          | _::zs -> zs (* xxx/z/.. => xxx *)
+          end
+      | x::xs -> x :: normalize_rev xs
+    in
+    let revs = normalize_rev t.revs in
+    { t with drive; revs; normalized = true }
+
+let to_string t =
+  let compos = List.rev t.revs in
+  let concats = String.concat t.op#sep in
+  match t.drive, t.abs, compos with
+  | None, true, [] -> t.op#sep
+  | None, true, _ -> concats ("" :: compos)
+  | None, false, [] -> t.op#current
+  | None, false, _ -> concats compos
+  | Some d, true, _ when t.op#is_network_drive d -> d ^ concats compos
+  | Some d, false, _ when t.op#is_network_drive d -> assert false
+  | Some d, true, [] -> d ^ t.op#sep
+  | Some d, true, _ -> d ^ concats ("" :: compos)
+  | Some d, false, [] -> d ^ t.op#current
+  | Some d, false, _ -> d ^ concats compos
+      
+let is_absolute t = t.abs
+let is_relative t = not t.abs
+
+let is_root t = t.abs && let t = normalize t in t.revs = []
+
+let dirbase t = 
+  let t = normalize t in
+  match t.revs with
+  | [] -> t, None
+  | x::_ when x = t.op#parent -> invalid_arg "dirbase"
+  | x::xs -> { t with revs = xs }, Some x
+
+let (^/) x s = 
+  let y = of_string x.os s in
+  if is_absolute y then invalid_arg "(^/)"
+  else normalize { x with revs = y.revs @ x.revs; normalized = false }
+
+let concats x ss = List.fold_left (^/) x ss
+
+let parent t = 
+  let t = normalize t in
+  match t.revs with
+  | [] when t.abs -> t
+  | [] -> { t with revs = [ t.op#parent ] }
+  | x::_ when x = t.op#parent -> { t with revs = t.op#parent :: t.revs }
+  | _::xs -> { t with revs = xs }
+
+let wrap os f s = to_string (f (normalize (of_string os s)))
+
+let is_prefix x y =
+  if x.os = y.os && x.abs = y.abs then
+    let rec is_prefix xs ys = match xs, ys with
+      | [], ys -> Some ys
+      | x::xs, y::ys when x = y -> is_prefix xs ys
+      | _ -> None
+    in
+    is_prefix (List.rev x.revs) (List.rev y.revs)
+  else None
+
+let test () =
+  let norm os s eq = 
+    let res = wrap os (fun x -> x) s in
+    if res <> eq then begin
+      Format.eprintf "Filepath.test failed: %S => %S => %S@." s res eq;
+      assert false
+    end
   in
-  if dir = F.current_dir_name then false, st
-  else if dir = F.dir_sep || dir = "/" then true, st
-  else split st dir
+  List.iter (fun (os, s, eq) -> norm os s eq) 
+    [ Unix, "/a/b/c", "/a/b/c";
 
-let split = split []
+      Unix, "a/b/c", "a/b/c";
       
-let () = 
-  match Sys.os_type with
-  | "Unix" -> 
-      assert (split ""       = (false, [""]));
-      assert (split "."      = (false, [""]));
-      assert (split "/"      = (true, [""]));
-      assert (split "/."     = (true, [""]));
-      assert (split "./"     = (false, [""]));
-      assert (split ".."     = (false, [".."]));
-      assert (split "/.."    = (true, [".."]));
-      assert (split "/.."    = (true, [".."]));
-      assert (split "//"     = (true, [""]));
-      assert (split "///"    = (true, [""]));
-      assert (split "a/"     = (false, ["a"]));
-      assert (split "a/."    = (false, ["a"; ""]));
-      assert (split "a/b"    = (false, ["a"; "b"]));
-      assert (split "a/b/"   = (false, ["a"; "b"]));
-      assert (split "a/b/."  = (false, ["a"; "b"; ""]));
-      assert (split "a//b/." = (false, ["a"; "b"; ""]))
-  | _ -> ()
+      Unix, "//a/b/c", "/a/b/c";
+      
+      Unix, "///a/b/c", "/a/b/c";
 
-let rec rev_normalize rev abs = function
-  | [] -> rev
-  | x::xs ->
-      if x = F.dir_sep || x = F.current_dir_name then assert false;
-      if x = F.parent_dir_name then
-        match rev with
-        | [] -> rev_normalize (if abs then [] else [F.parent_dir_name]) abs xs
-        | r::_ when r = F.parent_dir_name -> rev_normalize (x::rev) abs xs
-        | _::rs -> rev_normalize rs abs xs
-      else if x = "" then rev_normalize rev abs xs
-      else rev_normalize (x::rev) abs xs
+      Unix, "/", "/";
+
+      Unix, "//", "/";
+
+      Unix, "///", "/";
+
+      Unix, ".", ".";
+
+      Unix, "./", ".";
+
+      Unix, "/.", "/";
+
+      Unix, "/a/./b/./c/", "/a/b/c";
+
+      Unix, "/a/../b/../c/", "/c"; 
+
+      Unix, "../../a/../b", "../../b";
+
+      Unix, "..", "..";
+
+      Unix, "/..", "/";
+
+      Unix, "a/.", "a";
+
+      Unix, "a//b/.", "a/b";
+
+      Unix, "", "."; (* ??? *)
       
+      Win32, "\\a\\b\\c", "\\a\\b\\c";
+
+      Win32, "c:\\a\\b\\c", "C:\\a\\b\\c";
+
+      Win32, "c:/a/b/c", "C:\\a\\b\\c";
+
+      Win32, "c:a/b/c", "C:a\\b\\c";
+
+      Win32, "c:", "C:.";
+
+      Win32, "//a/b", "\\\\a\\b";
+    ]
+  
+(*
+let get_component : string -> string = Hashtbl.memoize (Hashtbl.create 1023) (fun x -> x)
+
+let dotdot = get_component (parent_dir_name)
+
 let hashcons_list = 
   let cache = Hashtbl.create 1023 in
   let rec f xs = Hashtbl.memoize cache (function
     | x::xs -> x :: f xs) xs
   in
   f
-
-let rev_normalize rev abs xs = hashcons_list (rev_normalize rev abs xs)
-
-let () = 
-  assert (rev_normalize [] false [] = []);
-  assert (rev_normalize [] false [""] = []);
-  assert (rev_normalize [] false [""; ""] = []);
-  assert (rev_normalize [] false ["a"; ""] = ["a"]);
-  assert (rev_normalize [] false [""; "a"] = ["a"]);
-  assert (rev_normalize [] false ["a"; ""] == rev_normalize [] false [""; "a"]);
-  assert (rev_normalize [] false ["a"; ".."] = []);
-  assert (rev_normalize [] false ["a"; ".."; "b"] = ["b"]);
-  assert (rev_normalize [] false [".."; "a"] = ["a"; ".."]);
-  assert (rev_normalize [] false [".."; "a"; ".."] = [".."]);
-  assert (rev_normalize [] false [".."; "a"; "b"; ".."; ".."; "c"] = ["c"; ".."]);
-  assert (rev_normalize [] false [".."; "a"; ".."; ".."; "c"] = ["c"; ".."; ".."]);
-  assert (rev_normalize [] true  [".."; "a"] = ["a"]);
-  assert (rev_normalize [] true  [".."; "a"; ".."] = []);
-  assert (rev_normalize [] true  [".."; "a"; "b"; ".."; ".."; "c"] = ["c"]);
-  assert (rev_normalize [] true  [".."; "a"; ".."; ".."; "c"] = ["c"]);
-
-type t = bool * string list
-
-let equal (b1,xs1) (b2,xs2) = b1 = b2 && xs1 == xs2
-
-let compare t1 t2 = if equal t1 t2 then 0 else compare t1 t2
-
-let contains_abs (b1,dir) (b2,f) =
-  assert (b1 && b2);
-  let dir = List.rev dir in
-  let f = List.rev f in
-  let rec loop dir f = match dir, f with
-    | [], fs -> Some fs
-    | d::ds, f::fs when d = f -> loop ds fs
-    | _::_, _ -> None
-  in
-  loop dir f
-
-let () = 
-  assert (contains_abs (true, ["c"; "b"; "a"]) (true, ["e"; "d"; "c"; "b"; "a"]) =
-      Some ["d"; "e"])
-
-let of_string path = 
-  let abs, xs = split path in
-  abs, rev_normalize [] abs xs
-
-let to_string (abs, rev) =
-  let xs = List.rev rev in
-  let xs = if abs then "" :: xs else xs in
-  if xs = [] then "." else String.concat (F.dir_sep) xs
-
-let is_absolute (abs, _) = abs
-let is_relative (abs, _) = not abs
-
-let root = (true, [])
-let is_root = function 
-  | (true, []) -> true
-  | _ -> false
-
-let dirbase (abs, xs) = match xs with
-  | [] | ".." :: _ -> (abs, xs), None
-  | x::xs -> (abs, xs), Some x
-
-let (^/) (abs, xs) s = 
-  let abs', ys = split s in
-  assert (not abs');
-  abs, rev_normalize xs abs ys
-
-let parent = function
-  | (false, (".."::_ | [] as xs)) -> (false, dotdot :: xs)
-  | (true, []) -> (true, [])
-  | (abs, (_::xs)) -> (abs, xs)
-
-let wrap f s = to_string (f (of_string s))
+*)
 
 (* File path normalization *)
 
+type os = 
+  | Unix   (** We love *)
+  | Win32  (** We hate *)
+  | Cygwin (** A failed effort of reconcillation *)
+
+val os : os
+(** The actual OS the program is running on *)
+
 type t
 
-val compare : t -> t -> int
-val equal : t -> t -> bool
+val is_prefix : t -> t -> string list option
+(** [is_prefix a b] checks [a] is a perfix of [b]. 
 
-val contains_abs : t -> t -> string list option
-(** contains_abs /a/b/c /a/b/c/d/e = Some ["d"; "e"] 
-    Only works for absolute paths
+    For example,
+
+    [is_prefix /a/b/c /a/b/c/d/e = Some ["d"; "e"]] 
+    [is_prefix a/b/c a/b/c/d/e = Some ["d"; "e"]] 
 *)
 
-val of_string : string -> t
+val of_string : os -> string -> t
+(** Parsing. No normalization performed. *)
+
 val to_string : t -> string
+(** Printing *)
+
+val normalize : t -> t
+(** Normalize the path.
+
+    * Drive name capitalization/uncapitalization
+    * Use backslashes in Win32
+    * Elimination of redundant /./ and /../, if possible.
+*)
+
 val is_absolute : t -> bool
 val is_relative : t -> bool
-val root : t
 val is_root : t -> bool
+
 val dirbase : t -> t * string option
+(** Split the path into its directory and base parts.
+
+    If the path is the root, it returns None.
+
+    It fails and raises [Invalid_argument "dirbase"],
+    when the path ends with "..".
+*)
+
 val (^/) : t -> string -> t
+(** Concatenation. 
+
+    [t ^/ "hello/world"]
+
+    [t ^/ x] raises [Invalid_argument "(^/)"] when [x] is a string
+    of an absolute path.
+*)
+
+val concats : t -> string list -> t
+(** Concatenation+
+
+    [concats t ["hello"; "world"; "good/bye"]]
+
+    should equal to
+
+    [t ^/ "hello" ^/ "world" ^/ "good" ^/ "bye"]
+
+    It raises [Invalid_argument "(^/)"] when the path components
+    contain an absolute path.
+*) 
+
 val parent : t -> t
-val wrap : (t -> t) -> string -> string
+
+val wrap : os -> (t -> t) -> string -> string
+
+val test : unit -> unit
     | None -> printf "Spot: no spot@."
     | Some (pident, res) -> 
         let src_file path =
-          let path' = FP.wrap Compdir.src_file path in
+          let path' = FP.wrap FP.os Compdir.src_file path in
           if path = path' then path 
           else
             if not (Sys.file_exists path') then begin
     | `Typecheck _ | `Recheck _ -> assert false
 end
 
-let _ = Main.main ()
+let () = if C.code_test then Test.test ()
 
+let () = Main.main ()
+
 let type_expand            = ref false
 let rest_args_rev          = ref []
 let use_spot               = ref false
+let code_test              = ref false
 
 let _ = 
   Arg.parse (Arg.align
 
       "--use-spot", 
       Arg.Set use_spot, " : use spot files instead of cmt, if exists";
+
+      "--code-test",
+      Arg.Set code_test, " : test some library functions";
     ])
     (fun s -> rev_anonargs := s :: !rev_anonargs)
     (Printf.sprintf 
 let print_interface        = !print_interface
 let type_expand            = !type_expand
 let use_spot               = !use_spot
+let code_test              = !code_test
 
 let dump_any = 
   dump_file || dump_rannots || dump_tree || dump_top || dump_flat

spotconfig_intf.ml

   val dump_flat              : bool
   val dump_any               : bool
   val eager_dump             : bool
-  
+
+  val code_test              : bool
+
   val no_definition_analysis : bool
   
   val strict_time_stamp      : bool
+let test () =
+  Utils.String.test ();
+  Filepath.test ()
 ##########################
 OCAMLC   = ocamlc -annot -bin-annot
 OCAMLOPT = ocamlopt -annot -bin-annot
-OCAMLDEP = ocamldep
+OCAMLDEP = ocamldep -slash
 OCAMLLEX = ocamllex
 OCAMLYACC= ocamlyacc
-OCAMLLIB = $(LIBDIR)
-OCAMLBIN = $(BINDIR)
 
 # Compilation
 #############
 
 include Lazy.Open
 
+module String = struct
+  include String
+
+  (* split a string according to char_sep predicate *)
+  let split char_sep str =
+    let len = String.length str in
+    if len = 0 then [] else
+      let rec skip_sep cur =
+        if cur >= len then cur
+        else if char_sep str.[cur] then skip_sep (succ cur)
+        else cur  in
+      let rec split beg cur =
+        if cur >= len then 
+  	if beg = cur then []
+  	else [String.sub str beg (len - beg)]
+        else if char_sep str.[cur] 
+  	   then 
+  	     let nextw = skip_sep cur in
+  	      (String.sub str beg (cur - beg))
+  		::(split nextw nextw)
+  	   else split beg (succ cur) in
+      let wstart = skip_sep 0 in
+      split wstart wstart
+
+
+  (** Same as [String.sub] but even if the string shorter for [len] 
+      the function succeeds and returns a shorter substring. 
+  *)
+  let sub' s pos len =
+    let orig_len = length s in
+    let len = max (min (pos + len) orig_len - pos) 0 in
+    sub s pos len
+
+  let test () =
+    assert (sub' "hello" 0 4 = "hell");
+    assert (sub' "hello" 0 5 = "hello");
+    assert (sub' "hello" 0 6 = "hello");
+    assert (sub' "hello" 0 7 = "hello");
+    assert (sub' "hello" 3 2 = "lo");
+    assert (sub' "hello" 3 3 = "lo");
+    assert (sub' "hello" 3 4 = "lo");
+    assert (sub' "hello" 5 5 = "")
+    
+  let find s pos f =
+    let len = length s in
+    let rec scan pos =
+      if pos >= len then None
+      else if f (unsafe_get s pos) then Some pos else scan (pos + 1)
+    in
+    scan pos
+
+  let replace_chars from to_ s =
+    let s' = copy s in
+    iteri (fun p -> function
+      | c when c = from -> unsafe_set s' p to_
+      | _ -> ()) s';
+    s'
+end
+
 module Filename = struct
   include Filename
       
     with
     | Invalid_argument _ -> s, ""
 
-  let concats xs = String.concat dir_sep xs
+  let concats = String.concat dir_sep
 
   module Open = struct
     let (^/) p1 p2 =
       if Filename.is_relative p2 then Filename.concat p1 p2 else p2
   end
+
 end
 
 include Filename.Open
 end
 include module type of Lazy.Open
 
+module String : sig
+  include module type of String
+  val split : (char -> bool) -> string -> string list
+
+  val sub' : string -> int -> int -> string
+  (** Same as [String.sub] but even if the string shorter for [len] 
+      the function succeeds and returns a shorter substring. 
+  *)
+
+  val find : string -> int -> (char -> bool) -> int option
+
+  val replace_chars : char -> char -> string -> string
+
+  val test : unit -> unit
+end
+
 module Filename : sig
   include module type of Filename
   val split_extension : string -> string * string
-  val concats : string list -> string
+
+    val concats : string list -> string
+
   module Open : sig
     val (^/) : string -> string -> string
   end
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.