(*
 * 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

let lookup_env f x env =
  try
    Some (f x env)
  with Not_found | Env.Error _ ->
    None

(* +-----------------------------------------------------------------+
   | 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) | String false | Quotation (_, false)), _) :: _ ->
        (* An unterminated command, string, or quotation. *)
        None
    | ((Uident id | Lident id), { idx1 = start }) :: tokens ->
        (* An identifier. *)
        let kind, path = loop [] tokens in
        Some (kind, path, start, id)
    | (Blanks, { idx2 = stop }) :: tokens ->
        (* Some blanks at the end. *)
        let kind, path = loop [] tokens in
        Some (kind, path, stop, "")
    | (_, { idx2 = 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 meth, { idx1 = start }) :: (Symbol "#", _) :: tokens -> begin
        match loop_methods [] tokens with
          | None -> None
          | Some (path, meths) -> Some (path, meths, start, meth)
      end
    | (Symbol "#", { idx2 = stop }) :: tokens
    | (Blanks, { idx2 = 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 id | 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)
      | [] ->
          Some (Fun, longident_of_list acc_uidents, acc_methods)
      | _ ->
          search tokens
  and loop_methods acc tokens =
    match tokens with
      | ((Lident id | 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
      | [] ->
          None
      | _ ->
          search tokens
  and search tokens =
    match tokens with
      | ((Lident id | 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 label, { idx1 = start }) :: (Symbol "~", _) :: tokens -> begin
        match search tokens with
          | None -> None
          | Some (kind, id, meths) -> Some (kind, id, meths, Required, start, label)
      end
    | (Symbol "~", { idx2 = stop }) :: tokens -> begin
        match search tokens with
          | None -> None
          | Some (kind, id, meths) -> Some (kind, id, meths, Required, stop, "")
      end
    | (Lident label, { idx1 = start }) :: (Symbol "?", _) :: tokens -> begin
        match search tokens with
          | None -> None
          | Some (kind, id, meths) -> Some (kind, id, meths, Optional, start, label)
      end
    | (Symbol "?", { idx2 = 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 phrase_terminator =
  String_map.bindings
    (Hashtbl.fold
       (fun dir kind map ->
          let suffix =
            match kind with
              | Toploop.Directive_none _ -> phrase_terminator
              | 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))

#if ocaml_version >= (4, 0, 0)
let field_name (id, _, _) = Ident.name id
let constructor_name (id, _, _) = Ident.name id
#else
let field_name (name, _, _) = name
let constructor_name (name, _) = name
#endif

let add_fields_of_type decl acc =
  match decl.type_kind with
    | Type_variant constructors ->
        acc
    | Type_record (fields, _) ->
        List.fold_left (fun acc field -> add (field_name field) 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 cstr -> add (constructor_name cstr) acc) acc constructors
    | Type_record (fields, _) ->
        List.fold_left (fun acc field -> add (field_name field) acc) acc fields
    | Type_abstract ->
        acc

#if ocaml_version >= (4, 0, 0)

let rec names_of_module_type = function
  | Mty_signature decls ->
      List.fold_left
        (fun acc decl -> match decl with
           | Sig_value (id, _)
           | Sig_exception (id, _)
           | Sig_module (id, _, _)
           | Sig_modtype (id, _)
           | Sig_class (id, _, _)
           | Sig_class_type (id, _, _) ->
               add (Ident.name id) acc
           | Sig_type (id, decl, _) ->
               add_names_of_type decl (add (Ident.name id) acc))
        String_set.empty decls
  | Mty_ident path -> begin
      match lookup_env Env.find_modtype path !Toploop.toplevel_env with
        | Some Modtype_abstract -> String_set.empty
        | Some Modtype_manifest module_type -> names_of_module_type module_type
        | None -> String_set.empty
    end
  | _ ->
      String_set.empty

let rec fields_of_module_type = function
  | Mty_signature decls ->
      List.fold_left
        (fun acc decl -> match decl with
           | Sig_value (id, _)
           | Sig_exception (id, _)
           | Sig_module (id, _, _)
           | Sig_modtype (id, _)
           | Sig_class (id, _, _)
           | Sig_class_type (id, _, _) ->
               acc
           | Sig_type (id, decl, _) ->
               add_fields_of_type decl acc)
        String_set.empty decls
  | Mty_ident path -> begin
      match lookup_env Env.find_modtype path !Toploop.toplevel_env with
        | Some Modtype_abstract -> String_set.empty
        | Some Modtype_manifest module_type -> fields_of_module_type module_type
        | None -> String_set.empty
    end
  | _ ->
      String_set.empty

#else

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 lookup_env Env.find_modtype path !Toploop.toplevel_env 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 lookup_env Env.find_modtype path !Toploop.toplevel_env 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

#endif

let names_of_module longident =
  try
    Longident_map.find longident !local_names_by_longident
  with Not_found ->
    match lookup_env Env.lookup_module longident !Toploop.toplevel_env 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 lookup_env Env.lookup_module longident !Toploop.toplevel_env 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 lookup_env Env.find_module path !Toploop.toplevel_env 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 lookup_env Env.find_module path !Toploop.toplevel_env 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

let replace x y set =
  if String_set.mem x set then
    String_set.add y (String_set.remove x set)
  else
    set

let global_names syntax =
  let set = Lazy.force !global_names in
  match syntax with
    | UTop.Normal | UTop.Camlp4o ->
        set
    | UTop.Camlp4r ->
        replace "true" "True" (replace "false" "False" set)

let global_fields () =
  Lazy.force !global_fields

(* +-----------------------------------------------------------------+
   | 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 lookup_env Env.find_type path !Toploop.toplevel_env 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 lookup_env Env.find_type path !Toploop.toplevel_env 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 lookup_env Env.lookup_value longident !Toploop.toplevel_env 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 lookup_env Env.find_type path !Toploop.toplevel_env 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 lookup_env Env.lookup_value longident !Toploop.toplevel_env 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 lookup_env Env.lookup_class longident !Toploop.toplevel_env with
    | None ->
        []
    | Some (path, { cty_new = None }) ->
        []
    | Some (path, { cty_new = Some type_expr }) ->
        labels_of_type String_map.empty type_expr

(* +-----------------------------------------------------------------+
   | Tokens processing                                               |
   +-----------------------------------------------------------------+ *)

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

(* Reverse and filter blanks and comments except for the last
   token. *)
let rec rev_filter acc tokens =
  match tokens with
    | [] -> acc
    | [((Blanks | Comment (_, true)), loc)] -> (Blanks, loc) :: acc
    | ((Blanks | Comment (_, true)), _) :: rest -> rev_filter acc rest
    | x :: rest -> rev_filter (x :: acc) rest

(* Find the current context. *)
let rec find_context tokens = function
  | [] ->
      Some (rev_filter [] tokens)
  | [(Quotation (items, false), _)] ->
      find_context_in_quotation items
  | _ :: rest ->
      find_context tokens rest

and find_context_in_quotation = function
  | [] ->
      None
  | [(Quot_anti { a_closing = None; a_contents = tokens }, _)] ->
      find_context tokens tokens
  | _ :: rest ->
      find_context_in_quotation rest

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

let complete ~syntax ~phrase_terminator ~input =
  let true_name, false_name =
    match syntax with
      | UTop.Normal | UTop.Camlp4o ->
          ("true", "false")
      | UTop.Camlp4r ->
          ("True", "False")
  in
  let tokens = UTop_lexer.lex_string syntax input in
  (* Filter blanks and comments. *)
  let tokens = filter tokens in
  match tokens with

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

    (* Complete with ";;" when possible. *)
    | [(Symbol "#", _); ((Lident _ | Uident _), _); (String true, { idx2 = stop })]
    | [(Symbol "#", _); ((Lident _ | Uident _), _); (String true, _); (Blanks, { idx2 = stop })] ->
        (stop, [(phrase_terminator, "")])
    | [(Symbol "#", _); ((Lident _ | Uident _), _); (String true, _); (Symbol sym, { idx1 = start })] ->
        if Zed_utf8.starts_with phrase_terminator sym then
          (start, [(phrase_terminator, "")])
        else
          (0, [])

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

    (* Completion on #load. *)
    | [(Symbol "#", _); (Lident "load", _); (String false, loc)] ->
        let file = String.sub input (loc.ofs1 + 1) (String.length input - loc.ofs1 - 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
        (loc.idx2 - Zed_utf8.length name,
         List.map (function (w, Directory) -> (w, "") | (w, File) -> (w, "\"" ^ phrase_terminator)) result)

    (* Completion on #use. *)
    | [(Symbol "#", _); (Lident "use", _); (String false, loc)] ->
        let file = String.sub input (loc.ofs1 + 1) (String.length input - loc.ofs1 - 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
        (loc.idx2 - Zed_utf8.length name,
         List.map (function (w, Directory) -> (w, "") | (w, File) -> (w, "\"" ^ phrase_terminator)) result)

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

    (* Generic completion on directives. *)
    | [(Symbol "#", _); ((Lident dir | Uident dir), _); (Blanks, { idx2 = stop })] ->
        (stop,
         match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with
           | Some (Toploop.Directive_none _) -> [(phrase_terminator, "")]
           | Some (Toploop.Directive_string _) -> [(" \"", "")]
           | Some (Toploop.Directive_bool _) -> [(true_name, phrase_terminator); (false_name, phrase_terminator)]
           | Some (Toploop.Directive_int _) -> []
           | Some (Toploop.Directive_ident _) -> List.map (fun w -> (w, "")) (String_set.elements (global_names syntax))
           | None -> [])
    | (Symbol "#", _) :: ((Lident dir | Uident dir), _) :: tokens -> begin
        match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with
          | Some (Toploop.Directive_none _) ->
              (0, [])
          | Some (Toploop.Directive_string _) ->
              (0, [])
          | Some (Toploop.Directive_bool _) -> begin
              match tokens with
                | [(Lident id, { idx1 = start })] ->
                    (start, lookup_assoc id [(true_name, phrase_terminator); (false_name, phrase_terminator)])
                | _ ->
                    (0, [])
            end
          | Some (Toploop.Directive_int _) ->
              (0, [])
          | Some (Toploop.Directive_ident _) -> begin
              match parse_longident (List.rev tokens) with
                | Some (Value, None, start, id) ->
                    (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (global_names syntax))))
                | Some (Value, Some longident, start, id) ->
                    (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (names_of_module longident))))
                | _ ->
                    (0, [])
            end
          | None ->
              (0, [])
      end

    (* Completion on identifiers. *)
    | _ ->
        match find_context tokens tokens with
          | None ->
              (0, [])
          | Some [] ->
              (0, List.map (fun w -> (w, "")) (String_set.elements (String_set.union !UTop.keywords (global_names syntax))))
          | Some tokens ->
              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 (global_names syntax)))))
                            | 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 (global_fields ()))))
                            | Some (Field, Some longident, start, id) ->
                                (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (fields_of_module longident))))