(*
 * uTop_complete.ml
 * ----------------
 * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org>
 * Licence   : BSD3
 *
 * This file is a part of utop.
 *)

open Types
open LTerm_read_line
open UTop_token

module String_set = Set.Make(String)
module String_map = Map.Make(String)

let set_of_list = List.fold_left (fun set x -> String_set.add x set) String_set.empty

(* +-----------------------------------------------------------------+
   | Utils                                                           |
   +-----------------------------------------------------------------+ *)

(* Transform a non-empty list of strings into a long-identifier. *)
let longident_of_list = function
  | [] ->
      invalid_arg "UTop_complete.longident_of_list"
  | component :: rest ->
      let rec loop acc = function
        | [] -> acc
        | component :: rest -> loop (Longident.Ldot(acc, component)) rest
      in
      loop (Longident.Lident component) rest

(* Check whether an identifier is a valid one. *)
let is_valid_identifier id =
  id <> "" &&
    (match id.[0] with
       | 'A' .. 'Z' | 'a' .. 'z' |  '_' -> true
       | _ -> false)

let add id set = if is_valid_identifier id then String_set.add id set else set

(* +-----------------------------------------------------------------+
   | Parsing                                                         |
   +-----------------------------------------------------------------+ *)

(* The following functions takes a list of tokens in reverse order. *)

type value_or_field = Value | Field
    (* Either a value, or a record field. *)

(* Parse something of the form [M1.M2. ... .Mn.id] or
   [field.M1.M2. ... .Mn.id] *)
let parse_longident tokens =
  let rec loop acc tokens =
    match tokens with
      | (Symbol, _, _, ".") :: (Uident, _, _, id) :: tokens ->
          loop (id :: acc) tokens
      | (Symbol, _, _, ".") :: (Lident, _, _, id) :: tokens ->
          (Field,
           match acc with
             | [] -> None
             | l -> Some (longident_of_list l))
      | _ ->
          (Value,
           match acc with
             | [] -> None
             | l -> Some (longident_of_list l))
  in
  match tokens with
    | ((Comment false | Doc false | String false | Quotation false), _, _, _) :: _ ->
        (* An unterminated command, string, or quotation. *)
        None
    | ((Uident | Lident), start, _, id) :: tokens ->
        (* An identifier. *)
        let kind, path = loop [] tokens in
        Some (kind, path, start, id)
    | (Blanks, _, stop, _) :: tokens ->
        (* Some blanks at the end. *)
        let kind, path = loop [] tokens in
        Some (kind, path, stop, "")
    | (_, _, stop, _) :: _ ->
        (* Otherwise complete after the last token. *)
        let kind, path = loop [] tokens in
        Some (kind, path, stop, "")
    | [] ->
        None

(* Parse something of the form [M1.M2. ... .Mn.id#m1#m2# ... #mp#m] *)
let parse_method tokens =
  (* Collect [M1.M2. ... .Mn.id] and returns the corresponding
     longidentifier. *)
  let rec loop_uidents acc tokens =
    match tokens with
      | (Symbol, _, _, ".") :: (Uident, _, _, id) :: tokens ->
          loop_uidents (id :: acc) tokens
      | _ ->
          longident_of_list acc
  in
  (* Collect [m1#m2# ... #mp] *)
  let rec loop_methods acc tokens =
    match tokens with
      | (Lident, _, _, meth) :: (Symbol, _, _, "#") :: tokens ->
          loop_methods (meth :: acc) tokens
      | (Lident, _, _, id) :: tokens ->
          Some (loop_uidents [id] tokens, acc)
      | _ ->
          None
  in
  match tokens with
    | (Lident, start, _, meth) :: (Symbol, _, _, "#") :: tokens -> begin
        match loop_methods [] tokens with
          | None -> None
          | Some (path, meths) -> Some (path, meths, start, meth)
      end
    | (Symbol, _, stop, "#") :: tokens
    | (Blanks, _, stop, _) :: (Symbol, _, _, "#") :: tokens -> begin
        match loop_methods [] tokens with
          | None -> None
          | Some (path, meths) -> Some (path, meths, stop, "")
      end
    | _ ->
        None

type label_kind = Required | Optional
    (* Kind of labels: required or optional. *)

type fun_or_new = Fun | New
    (* Either a function application, either an object creation. *)

(* Parse something of the form [M1.M2. ... .Mn.id#m1#m2# ... #mp expr1 ... exprq ~label]
   or [new M1.M2. ... .Mn.id expr1 ... exprq ~label] *)
let parse_label tokens =
  (* Collect [M1.M2. ... .Mn] *)
  let rec loop_uidents acc_uidents acc_methods tokens =
    match tokens with
      | (Lident, _, _, "new") :: _ ->
          Some (New, longident_of_list acc_uidents, acc_methods)
      | ((Lident | Uident), _, _, id) :: _ when String_set.mem id !UTop.keywords ->
          Some (Fun, longident_of_list acc_uidents, acc_methods)
      | (Symbol, _, _, ".") :: (Uident, _, _, id) :: tokens ->
          loop_uidents (id :: acc_uidents) acc_methods tokens
      | (Symbol, _, _, ("~" | "?" | ":" | "." | "#")) :: tokens ->
          search tokens
      | (Symbol, _, _, ")") :: tokens ->
          skip tokens "(" []
      | (Symbol, _, _, "}") :: tokens ->
          skip tokens "{" []
      | (Symbol, _, _, "]") :: tokens ->
          skip tokens "[" []
      | (Symbol, _, _, _) :: _ ->
          Some (Fun, longident_of_list acc_uidents, acc_methods)
      | _ :: tokens ->
          search tokens
      | [] ->
          Some (Fun, longident_of_list acc_uidents, acc_methods)
  and loop_methods acc tokens =
    match tokens with
      | ((Lident | Uident), _, _, id) :: _ when String_set.mem id !UTop.keywords ->
          None
      | (Symbol, _, _, ("~" | "?" | ":" | "." | "#")) :: tokens ->
          search tokens
      | (Symbol, _, _, ")") :: tokens ->
          skip tokens "(" []
      | (Symbol, _, _, "}") :: tokens ->
          skip tokens "{" []
      | (Symbol, _, _, "]") :: tokens ->
          skip tokens "[" []
      | (Symbol, _, _, _) :: _ ->
          None
      | (Lident, _, _, id) :: (Symbol, _, _, "#") :: tokens ->
          loop_methods (id :: acc) tokens
      | (Lident, _, _, id) :: tokens ->
          loop_uidents [id] acc tokens
      | _ :: tokens ->
          search tokens
      | [] ->
          None
  and search tokens =
    match tokens with
      | ((Lident | Uident), _, _, id) :: _ when String_set.mem id !UTop.keywords ->
          None
      | (Symbol, _, _, ("~" | "?" | ":" | "." | "#")) :: tokens ->
          search tokens
      | (Symbol, _, _, ")") :: tokens ->
          skip tokens "(" []
      | (Symbol, _, _, "}") :: tokens ->
          skip tokens "{" []
      | (Symbol, _, _, "]") :: tokens ->
          skip tokens "[" []
      | (Symbol, _, _, _) :: _ ->
          None
      | (Lident, _, _, id) :: (Symbol, _, _, "#") :: tokens ->
          loop_methods [id] tokens
      | (Lident, _, _, id) :: tokens ->
          loop_uidents [id] [] tokens
      | _ :: tokens ->
          search tokens
      | [] ->
          None
  and skip tokens top stack =
    match tokens with
      | (Symbol, _, _, symbol) :: tokens when symbol = top -> begin
          match stack with
            | [] -> search tokens
            | top :: stack -> skip tokens top stack
        end
      | (Symbol, _, _, ")") :: tokens ->
          skip tokens "(" (top :: stack)
      | (Symbol, _, _, "}") :: tokens ->
          skip tokens "{" (top :: stack)
      | (Symbol, _, _, "]") :: tokens ->
          skip tokens "[" (top :: stack)
      | _ :: tokens ->
          skip tokens top stack
      | [] ->
          None
  in
  match tokens with
    | (Lident, start, _, label) :: (Symbol, _, _, "~") :: tokens -> begin
        match search tokens with
          | None -> None
          | Some (kind, id, meths) -> Some (kind, id, meths, Required, start, label)
      end
    | (Symbol, _, stop, "~") :: tokens -> begin
        match search tokens with
          | None -> None
          | Some (kind, id, meths) -> Some (kind, id, meths, Required, stop, "")
      end
    | (Lident, start, _, label) :: (Symbol, _, _, "?") :: tokens -> begin
        match search tokens with
          | None -> None
          | Some (kind, id, meths) -> Some (kind, id, meths, Optional, start, label)
      end
    | (Symbol, _, stop, "?") :: tokens -> begin
        match search tokens with
          | None -> None
          | Some (kind, id, meths) -> Some (kind, id, meths, Optional, stop, "")
      end
    | _ ->
        None

(* +-----------------------------------------------------------------+
   | Directive listing                                               |
   +-----------------------------------------------------------------+ *)

let list_directives () =
  String_map.bindings
    (Hashtbl.fold
       (fun dir kind map ->
          let suffix =
            match kind with
              | Toploop.Directive_none _ -> ";;"
              | Toploop.Directive_string _ -> " \""
              | Toploop.Directive_bool _  | Toploop.Directive_int _ | Toploop.Directive_ident _ -> " "
          in
          String_map.add dir suffix map)
       Toploop.directive_table
       String_map.empty)

(* +-----------------------------------------------------------------+
   | File listing                                                    |
   +-----------------------------------------------------------------+ *)

type file_kind = Directory | File

let basename name =
  let name' = Filename.basename name in
  if name' = "." && not (Zed_utf8.ends_with name ".") then
    ""
  else
    name'

let add_files filter acc dir =
  Array.fold_left
    (fun map name ->
       let absolute_name = Filename.concat dir name in
       if try Sys.is_directory absolute_name with Sys_error _ -> false then
         String_map.add (Filename.concat name "") Directory map
       else if filter name then
         String_map.add name File map
       else
         map)
    acc
    (try Sys.readdir dir with Sys_error _ -> [||])

let list_directories dir =
  String_set.elements
    (Array.fold_left
       (fun set name ->
          let absolute_name = Filename.concat dir name in
          if try Sys.is_directory absolute_name with Sys_error _ -> false then
            String_set.add name set
          else
            set)
       String_set.empty
       (try Sys.readdir (if dir = "" then Filename.current_dir_name else dir) with Sys_error _ -> [||]))

(* +-----------------------------------------------------------------+
   | Names listing                                                   |
   +-----------------------------------------------------------------+ *)

module Path_map = Map.Make(struct type t = Path.t let compare = compare end)
module Longident_map = Map.Make(struct type t = Longident.t let compare = compare end)

(* All names accessible without a path. *)
let global_names = ref (lazy String_set.empty)

(* All names accessible with a path, by path. *)
let local_names_by_path = ref Path_map.empty

(* All names accessible with a path, by long identifier. *)
let local_names_by_longident = ref Longident_map.empty

(* All record fields accessible without a path. *)
let global_fields = ref (lazy String_set.empty)

(* All record fields accessible with a path, by path. *)
let local_fields_by_path = ref Path_map.empty

(* All record fields accessible with a path, by long identifier. *)
let local_fields_by_longident = ref Longident_map.empty

(* Returns [acc] plus all modules from [dir]. *)
let add_modules_from_directory acc dir =
  Array.fold_left
    (fun acc fname ->
       if Filename.check_suffix fname ".cmi" then
         String_set.add (String.capitalize (Filename.chop_suffix fname ".cmi")) acc
       else
         acc)
    acc
    (Sys.readdir (if dir = "" then Filename.current_dir_name else dir))

let add_fields_of_type decl acc =
  match decl.type_kind with
    | Type_variant constructors ->
        acc
    | Type_record(fields, _) ->
        List.fold_left (fun acc (name, _, _) -> add name acc) acc fields
    | Type_abstract ->
        acc

let add_names_of_type decl acc =
  match decl.type_kind with
    | Type_variant constructors ->
        List.fold_left (fun acc (name, _) -> add name acc) acc constructors
    | Type_record(fields, _) ->
        List.fold_left (fun acc (name, _, _) -> add name acc) acc fields
    | Type_abstract ->
        acc

let rec names_of_module_type = function
  | Tmty_signature decls ->
      List.fold_left
        (fun acc decl -> match decl with
           | Tsig_value(id, _)
           | Tsig_exception(id, _)
           | Tsig_module(id, _, _)
           | Tsig_modtype(id, _)
           | Tsig_class(id, _, _)
           | Tsig_cltype(id, _, _) ->
               add (Ident.name id) acc
           | Tsig_type(id, decl, _) ->
               add_names_of_type decl (add (Ident.name id) acc))
        String_set.empty decls
  | Tmty_ident path -> begin
      match try Some (Env.find_modtype path !Toploop.toplevel_env) with Not_found -> None with
        | Some Tmodtype_abstract -> String_set.empty
        | Some Tmodtype_manifest module_type -> names_of_module_type module_type
        | None -> String_set.empty
    end
  | _ ->
      String_set.empty

let rec fields_of_module_type = function
  | Tmty_signature decls ->
      List.fold_left
        (fun acc decl -> match decl with
           | Tsig_value(id, _)
           | Tsig_exception(id, _)
           | Tsig_module(id, _, _)
           | Tsig_modtype(id, _)
           | Tsig_class(id, _, _)
           | Tsig_cltype(id, _, _) ->
               acc
           | Tsig_type(id, decl, _) ->
               add_fields_of_type decl acc)
        String_set.empty decls
  | Tmty_ident path -> begin
      match try Some (Env.find_modtype path !Toploop.toplevel_env) with Not_found -> None with
        | Some Tmodtype_abstract -> String_set.empty
        | Some Tmodtype_manifest module_type -> fields_of_module_type module_type
        | None -> String_set.empty
    end
  | _ ->
      String_set.empty

let names_of_module longident =
  try
    Longident_map.find longident !local_names_by_longident
  with Not_found ->
    match try Some (Env.lookup_module longident !Toploop.toplevel_env) with Not_found -> None with
      | Some(path, module_type) ->
          let names = names_of_module_type module_type in
          local_names_by_path := Path_map.add path names !local_names_by_path;
          local_names_by_longident := Longident_map.add longident names !local_names_by_longident;
          names
      | None ->
          local_names_by_longident := Longident_map.add longident String_set.empty !local_names_by_longident;
          String_set.empty

let fields_of_module longident =
  try
    Longident_map.find longident !local_fields_by_longident
  with Not_found ->
    match try Some (Env.lookup_module longident !Toploop.toplevel_env) with Not_found -> None with
      | Some(path, module_type) ->
          let fields = fields_of_module_type module_type in
          local_fields_by_path := Path_map.add path fields !local_fields_by_path;
          local_fields_by_longident := Longident_map.add longident fields !local_fields_by_longident;
          fields
      | None ->
          local_fields_by_longident := Longident_map.add longident String_set.empty !local_fields_by_longident;
          String_set.empty

let list_global_names () =
  let rec loop acc = function
    | Env.Env_empty -> acc
    | Env.Env_value(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_type(summary, id, decl) ->
        loop (add_names_of_type decl (add (Ident.name id) acc)) summary
    | Env.Env_exception(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_module(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_modtype(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_class(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_cltype(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_open(summary, path) ->
        match try Some (Path_map.find path !local_names_by_path) with Not_found -> None with
          | Some names ->
              loop (String_set.union acc names) summary
          | None ->
              match try Some (Env.find_module path !Toploop.toplevel_env) with Not_found -> None with
                | Some module_type ->
                    let names = names_of_module_type module_type in
                    local_names_by_path := Path_map.add path names !local_names_by_path;
                    loop (String_set.union acc names) summary
                | None ->
                    local_names_by_path := Path_map.add path String_set.empty !local_names_by_path;
                    loop acc summary
  in
  (* Add names of the environment: *)
  let acc = loop String_set.empty (Env.summary !Toploop.toplevel_env) in
  (* Add accessible modules: *)
  List.fold_left add_modules_from_directory acc !Config.load_path

let list_global_fields () =
  let rec loop acc = function
    | Env.Env_empty -> acc
    | Env.Env_value(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_type(summary, id, decl) ->
        loop (add_fields_of_type decl (add (Ident.name id) acc)) summary
    | Env.Env_exception(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_module(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_modtype(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_class(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_cltype(summary, id, _) ->
        loop (add (Ident.name id) acc) summary
    | Env.Env_open(summary, path) ->
        match try Some (Path_map.find path !local_fields_by_path) with Not_found -> None with
          | Some fields ->
              loop (String_set.union acc fields) summary
          | None ->
              match try Some (Env.find_module path !Toploop.toplevel_env) with Not_found -> None with
                | Some module_type ->
                    let fields = fields_of_module_type module_type in
                    local_fields_by_path := Path_map.add path fields !local_fields_by_path;
                    loop (String_set.union acc fields) summary
                | None ->
                    local_fields_by_path := Path_map.add path String_set.empty !local_fields_by_path;
                    loop acc summary
  in
  (* Add fields of the environment: *)
  let acc = loop String_set.empty (Env.summary !Toploop.toplevel_env) in
  (* Add accessible modules: *)
  List.fold_left add_modules_from_directory acc !Config.load_path

let reset () =
  global_names := Lazy.lazy_from_fun list_global_names;
  local_names_by_path := Path_map.empty;
  local_names_by_longident := Longident_map.empty;
  global_fields := Lazy.lazy_from_fun list_global_fields;
  local_fields_by_path := Path_map.empty;
  local_fields_by_longident := Longident_map.empty

(* +-----------------------------------------------------------------+
   | Listing methods                                                 |
   +-----------------------------------------------------------------+ *)

let rec find_method meth type_expr =
  match type_expr.desc with
    | Tlink type_expr ->
        find_method meth type_expr
    | Tobject (type_expr, _) ->
        find_method meth type_expr
    | Tfield (name, _, type_expr, rest) ->
        if name = meth then
          Some type_expr
        else
          find_method meth rest
    | Tpoly (type_expr, _) ->
        find_method meth type_expr
    | Tconstr (path, _, _) -> begin
        match try Some (Env.find_type path !Toploop.toplevel_env) with Not_found -> None with
          | None
          | Some { type_manifest = None } ->
              None
          | Some { type_manifest = Some type_expr } ->
              find_method meth type_expr
      end
    | _ ->
        None

let rec methods_of_type acc type_expr =
  match type_expr.desc with
    | Tlink type_expr ->
        methods_of_type acc type_expr
    | Tobject (type_expr, _) ->
        methods_of_type acc type_expr
    | Tfield (name, _, _, rest) ->
        methods_of_type (add name acc) rest
    | Tpoly (type_expr, _) ->
        methods_of_type acc type_expr
    | Tconstr (path, _, _) -> begin
        match try Some (Env.find_type path !Toploop.toplevel_env) with Not_found -> None with
          | None
          | Some { type_manifest = None } ->
              acc
          | Some { type_manifest = Some type_expr } ->
              methods_of_type acc type_expr
      end
    | _ ->
        acc

let rec find_object meths type_expr =
  match meths with
    | [] ->
        Some type_expr
    | meth :: meths ->
        match find_method meth type_expr with
          | Some type_expr ->
              find_object meths type_expr
          | None ->
              None

let methods_of_object longident meths =
  match try Some (Env.lookup_value longident !Toploop.toplevel_env) with Not_found -> None with
    | None ->
        []
    | Some (path, { val_type = type_expr }) ->
        match find_object meths type_expr with
          | None ->
              []
          | Some type_expr ->
              String_set.elements (methods_of_type String_set.empty type_expr)

(* +-----------------------------------------------------------------+
   | Listing labels                                                  |
   +-----------------------------------------------------------------+ *)

let rec labels_of_type acc type_expr =
  match type_expr.desc with
    | Tlink te ->
        labels_of_type acc te
    | Tpoly (te, _) ->
        labels_of_type acc te
    | Tarrow(label, _, te, _) ->
        if label = "" then
          labels_of_type acc te
        else if label.[0] = '?' then
          labels_of_type (String_map.add (String.sub label 1 (String.length label - 1)) Optional acc) te
        else
          labels_of_type (String_map.add label Required acc) te
    | Tconstr(path, _, _) -> begin
        match try Some (Env.find_type path !Toploop.toplevel_env) with Not_found -> None with
          | None
          | Some { type_manifest = None } ->
              String_map.bindings acc
          | Some { type_manifest = Some type_expr } ->
              labels_of_type acc type_expr
      end
    | _ ->
        String_map.bindings acc

let labels_of_function longident meths =
  match try Some (Env.lookup_value longident !Toploop.toplevel_env) with Not_found -> None with
    | None ->
        []
    | Some (path, { val_type = type_expr }) ->
        match find_object meths type_expr with
          | None ->
              []
          | Some type_expr ->
              labels_of_type String_map.empty type_expr

let labels_of_newclass longident =
  match try Some (Env.lookup_class longident !Toploop.toplevel_env) with Not_found -> None with
    | None ->
        []
    | Some (path, { cty_new = None }) ->
        []
    | Some (path, { cty_new = Some type_expr }) ->
        labels_of_type String_map.empty type_expr

(* +-----------------------------------------------------------------+
   | Filtering                                                       |
   +-----------------------------------------------------------------+ *)

(* Filter blanks and comments except for the last token. *)
let rec filter tokens =
  match tokens with
    | [] -> []
    | [((Blanks | Comment true | Doc true), start, stop, src)] -> [(Blanks, start, stop, src)]
    | ((Blanks | Comment true | Doc true), _, _, _) :: rest -> filter rest
    | x :: rest -> x :: filter rest

(* +-----------------------------------------------------------------+
   | Completion                                                      |
   +-----------------------------------------------------------------+ *)

let complete str =
  let tokens = UTop_lexer.lex_string str in
  (* Filter blanks and comments. *)
  let tokens = filter tokens in
  match tokens with

    (* Completion on directive names. *)
    | [(Symbol, _, stop, "#")]
    | [(Symbol, _, _, "#"); (Blanks, _, stop, _)] ->
        (stop, list_directives ())
    | [(Symbol, _, _, "#"); ((Lident | Uident), start, _, src)] ->
        (start, lookup_assoc src (list_directives ()))

    (* Complete with ";;" when possible. *)
    | [(Symbol, _, _, "#"); ((Lident | Uident), _, _, _); (String true, _, stop, _)]
    | [(Symbol, _, _, "#"); ((Lident | Uident), _, _, _); (String true, _, _, _); (Blanks, _, stop, _)] ->
        (stop, [(";;", "")])
    | [(Symbol, _, _, "#"); ((Lident | Uident), _, _, _); (String true, _, _, _); (Symbol, start, _, ";")] ->
        (start, [(";;", "")])

    (* Completion on #require. *)
    | [(Symbol, _, _, "#"); (Lident, _, _, "require"); (String false, start, stop, str)] ->
        let pkg = String.sub str 1 (String.length str - 1) in
        let pkgs = lookup pkg (Fl_package_base.list_packages ()) in
        (start + 1, List.map (fun pkg -> (pkg, "\";;")) (List.sort compare pkgs))

    (* Completion on #load. *)
    | [(Symbol, _, _, "#"); (Lident, _, _, "load"); (String false, start, stop, str)] ->
        let file = String.sub str 1 (String.length str - 1) in
        let filter name = Filename.check_suffix name ".cma" || Filename.check_suffix name ".cmo" in
        let map =
          if Filename.is_relative file then
            let dir = Filename.dirname file in
            List.fold_left
              (fun acc d -> add_files filter acc (Filename.concat d dir))
              String_map.empty
              (Filename.current_dir_name :: !Config.load_path)
          else
            add_files filter String_map.empty (Filename.dirname file)
        in
        let list = String_map.bindings map in
        let name = basename file in
        let result = lookup_assoc name list in
        (stop - Zed_utf8.length name,
         List.map (function (w, Directory) -> (w, "") | (w, File) -> (w, "\";;")) result)

    (* Completion on #use. *)
    | [(Symbol, _, _, "#"); (Lident, _, _, "use"); (String false, start, stop, str)] ->
        let file = String.sub str 1 (String.length str - 1) in
        let filter name =
          match try Some (String.rindex name '.') with Not_found -> None with
            | None ->
                true
            | Some idx ->
                let ext = String.sub name (idx + 1) (String.length name - (idx + 1)) in
                ext = "ml"
        in
        let map =
          if Filename.is_relative file then
            let dir = Filename.dirname file in
            List.fold_left
              (fun acc d -> add_files filter acc (Filename.concat d dir))
              String_map.empty
              (Filename.current_dir_name :: !Config.load_path)
          else
            add_files filter String_map.empty (Filename.dirname file)
        in
        let list = String_map.bindings map in
        let name = basename file in
        let result = lookup_assoc name list in
        (stop - Zed_utf8.length name,
         List.map (function (w, Directory) -> (w, "") | (w, File) -> (w, "\";;")) result)

    (* Completion on #directory and #cd. *)
    | [(Symbol, _, _, "#"); (Lident, _, _, ("cd" | "directory")); (String false, start, stop, str)] ->
        let file = String.sub str 1 (String.length str - 1) in
        let list = list_directories (Filename.dirname file) in
        let name = basename file in
        let result = lookup name list in
        (stop - Zed_utf8.length name, List.map (function dir -> (dir, "")) result)

    (* Generic completion on directives. *)
    | [(Symbol, _, _, "#"); ((Lident | Uident), _, _, dir); (Blanks, _, stop, _)] ->
        (stop,
         match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with
           | Some (Toploop.Directive_none _) -> [(";;", "")]
           | Some (Toploop.Directive_string _) -> [(" \"", "")]
           | Some (Toploop.Directive_bool _) -> [("true", ";;"); ("false", ";;")]
           | Some (Toploop.Directive_int _) -> []
           | Some (Toploop.Directive_ident _) -> []
           | None -> [])
    | [(Symbol, _, _, "#"); ((Lident | Uident), _, _, dir); ((Lident | Uident), start, _, id)] ->
        (start,
         match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with
           | Some (Toploop.Directive_none _) -> []
           | Some (Toploop.Directive_string _) -> []
           | Some (Toploop.Directive_bool _) -> lookup_assoc id [("true", ";;"); ("false", ";;")]
           | Some (Toploop.Directive_int _) -> []
           | Some (Toploop.Directive_ident _) -> []
           | None -> [])

    (* Completion on identifiers. *)
    | [] ->
        (0, List.map (fun w -> (w, "")) (String_set.elements (String_set.union !UTop.keywords (Lazy.force !global_names))))
    | _ ->
        let tokens = List.rev tokens in
        match parse_method tokens with
          | Some (longident, meths, start, meth) ->
              (start, List.map (fun w -> (w, "")) (lookup meth (methods_of_object longident meths)))
          | None ->
              match parse_label tokens with
                | Some (Fun, longident, meths, Optional, start, label) ->
                    (start, List.map (fun (w, kind) -> (w, ":")) (lookup_assoc label (List.filter (function (w, Optional) -> true | (w, Required) -> false) (labels_of_function longident meths))))
                | Some (Fun, longident, meths, Required, start, label) ->
                    (start, List.map (fun (w, kind) -> (w, ":")) (lookup_assoc label (labels_of_function longident meths)))
                | Some (New, longident, meths, Optional, start, label) ->
                    (start, List.map (fun (w, kind) -> (w, ":")) (lookup_assoc label (List.filter (function (w, Optional) -> true | (w, Required) -> false) (labels_of_newclass longident))))
                | Some (New, longident, meths, Required, start, label) ->
                    (start, List.map (fun (w, kind) -> (w, ":")) (lookup_assoc label (labels_of_newclass longident)))
                | None ->
                    match parse_longident tokens with
                      | None ->
                          (0, [])
                      | Some (Value, None, start, id) ->
                          (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (String_set.union !UTop.keywords (Lazy.force !global_names)))))
                      | Some (Value, Some longident, start, id) ->
                          (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (names_of_module longident))))
                      | Some (Field, None, start, id) ->
                          (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (Lazy.force !global_fields))))
                      | Some (Field, Some longident, start, id) ->
                          (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (fields_of_module longident))))