Source file completion.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
module AcgEnv = AcgData.Environment.Environment
let completion_suffixes = [ [ Parser.COMPL_ARG_NAME ; Parser.INF ; Parser.DATA "" ]
; [ Parser.COMPL_ARG_NAME ]
; [ Parser.COMPL_ARG_VAL ]
; [ Parser.COMPL_ARG_VAL ; Parser.INF; Parser.DATA "" ]
; [ Parser.COMPL_FUN ]
; [ Parser.COMPL_FUN ; Parser.INF ; Parser.DATA "" ]
; [ Parser.COMPL_LET ] ]
let tok_to_string tok =
match tok with
| Parser.SEMI -> "semi"
| Parser.PIPE -> "pipe"
| Parser.LET -> "let"
| Parser.INF -> "inf"
| Parser.EQUAL -> "equal"
| Parser.COMMA -> "comma"
| Parser.PLUS -> "plus"
| Parser.MINUS -> "minus"
| Parser.EOI -> "EOI"
| Parser.COMPL_LET -> "compl_let"
| Parser.COMPL_FUN -> "compl_fun"
| Parser.COMPL_ARG_NAME -> "compl_arg_name"
| Parser.COMPL_ARG_VAL -> "compl_arg_val"
| Parser.COLON_EQUAL -> "colon_equal"
| Parser.INT i -> Printf.sprintf "int %i" i
| Parser.ID id -> Printf.sprintf "id %s" id
| Parser.DATA s -> Printf.sprintf "data %s" s
let completion_loop checkpoint lexbuf c_pos =
let rec completion_loop_rec checkpoint lexbuf c_pos =
match checkpoint with
| TableParser.MenhirInterpreter.InputNeeded _ -> (
let tok = Lexer.lex lexbuf in
let pstart, pend = Sedlexing.lexing_positions lexbuf in
if pend.Lexing.pos_cnum = c_pos then
match tok with
| Lexer.Token (Parser.EOI, _) -> Some ("", checkpoint)
| Lexer.Token (Parser.LET, _) -> Some ("let", checkpoint)
| Lexer.Token (Parser.ID id, _) -> Some (id, checkpoint)
| Lexer.Token (Parser.INT i, _) -> Some (string_of_int i, checkpoint)
| Lexer.PartialToken (s, _) -> Some (s, checkpoint)
| Lexer.Token (tok, _) ->
let new_checkpoint =
TableParser.MenhirInterpreter.offer checkpoint (tok, pstart, pend)
in
Some ("", new_checkpoint)
else
match tok with
| Lexer.Token (tok, _) ->
let new_checkpoint =
TableParser.MenhirInterpreter.offer checkpoint (tok, pstart, pend)
in
completion_loop_rec new_checkpoint lexbuf c_pos
| _ -> None)
| TableParser.MenhirInterpreter.Shifting _
| TableParser.MenhirInterpreter.AboutToReduce _ ->
let new_checkpoint = TableParser.MenhirInterpreter.resume checkpoint in
completion_loop_rec new_checkpoint lexbuf c_pos
| TableParser.MenhirInterpreter.HandlingError _
| TableParser.MenhirInterpreter.Rejected
| TableParser.MenhirInterpreter.Accepted _ -> None in
try completion_loop_rec checkpoint lexbuf c_pos with _ -> None
let completion_loop_2 checkpoint compl_list pos env =
let rec completion_loop_2_rec checkpoint compl_list (pstart, pend) =
match checkpoint with
| TableParser.MenhirInterpreter.InputNeeded _ ->
let compl_tok, new_compl_list = match compl_list with
| tok :: l -> tok, l
| [] -> Parser.EOI, [] in
let () = Logs.debug (fun m -> m "token : %s" (tok_to_string compl_tok)) in
let new_checkpoint =
TableParser.MenhirInterpreter.offer checkpoint (compl_tok, pstart, pend)
in
completion_loop_2_rec new_checkpoint new_compl_list (pend, pend)
| TableParser.MenhirInterpreter.Shifting _
| TableParser.MenhirInterpreter.AboutToReduce _ ->
let new_checkpoint = TableParser.MenhirInterpreter.resume checkpoint in
completion_loop_2_rec new_checkpoint compl_list (pstart, pend)
| TableParser.MenhirInterpreter.HandlingError _
| TableParser.MenhirInterpreter.Rejected ->
let () = Logs.debug (fun m -> m "Rejected") in ()
| TableParser.MenhirInterpreter.Accepted res ->
let () = Logs.debug (fun m -> m "Accepted") in
let _ = res env in ()
in
let () = Logs.debug (fun m -> m "------- compl ---------") in
try completion_loop_2_rec checkpoint compl_list pos; None with
| Environment.Completion completion ->
let () = Logs.debug (fun m -> m "Completion") in
Some completion
| _ -> None
let complete env cont_input input =
let compl_input = cont_input ^ input in
let lexbuf = Sedlexing.Utf8.from_string (compl_input) in
let start =
TableParser.Incremental.interactive_command
(fst (Sedlexing.lexing_positions lexbuf)) in
match completion_loop start lexbuf (String.length compl_input) with
| None -> Readline.Custom []
| Some (compl_text, compl_checkpoint) ->
let pos = Sedlexing.lexing_positions lexbuf in
let compl_list = List.fold_left
(fun res compl_list ->
match completion_loop_2 compl_checkpoint compl_list pos env with
| Some completion -> List.rev_append res (Environment.gen_completions completion compl_text env)
| _ -> res)
[] completion_suffixes in
let filtred_list =
List.filter
(fun e ->
match e with
| Environment.Ce_String (_compl, compl_comp, _compl_suff) -> String.starts_with ~prefix:compl_text compl_comp
| Environment.Ce_Path -> true)
compl_list in
if List.length compl_list > 0 && List.for_all ((=) Environment.Ce_Path) filtred_list
then Readline.Filenames
else Readline.Custom (List.filter_map
(fun s ->
match s with
| Environment.Ce_String (compl, _compl_comp, compl_suff) -> Some (compl, compl_suff)
| Environment.Ce_Path -> None)
filtred_list)