haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Remove camlp4 remnants

This commit is contained in:
Anton Kochkov 2019-07-08 15:30:37 +08:00 committed by Perry E. Metzger
parent 0c17ffa6b2
commit ca00ce6146
8 changed files with 50 additions and 196 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
src/lib/uTop.ml
View File

@ -66,15 +66,9 @@ let make_variable ?eq x =
let set v = set v in let set v = set v in
(signal, (fun () -> S.value signal), set) (signal, (fun () -> S.value signal), set)
type syntax =
| Normal
| Camlp4o
| Camlp4r
let hide_reserved, get_hide_reserved, set_hide_reserved = make_variable true let hide_reserved, get_hide_reserved, set_hide_reserved = make_variable true
let create_implicits, get_create_implicits, set_create_implicits = make_variable false let create_implicits, get_create_implicits, set_create_implicits = make_variable false
let show_box, get_show_box, set_show_box = make_variable true let show_box, get_show_box, set_show_box = make_variable true
let syntax, get_syntax, set_syntax = make_variable Normal
let phrase_terminator, get_phrase_terminator, set_phrase_terminator = make_variable ";;" let phrase_terminator, get_phrase_terminator, set_phrase_terminator = make_variable ";;"
let auto_run_lwt, get_auto_run_lwt, set_auto_run_lwt = make_variable true let auto_run_lwt, get_auto_run_lwt, set_auto_run_lwt = make_variable true
let auto_run_async, get_auto_run_async, set_auto_run_async = make_variable true let auto_run_async, get_auto_run_async, set_auto_run_async = make_variable true
@ -661,7 +655,7 @@ let () =
Hashtbl.add Toploop.directive_table "utop_save" (Toploop.Directive_string fn) Hashtbl.add Toploop.directive_table "utop_save" (Toploop.Directive_string fn)
(* +-----------------------------------------------------------------+ (* +-----------------------------------------------------------------+
| Camlp4 | | Findlib stuff |
+-----------------------------------------------------------------+ *) +-----------------------------------------------------------------+ *)
let print_error msg = let print_error msg =
@ -681,55 +675,6 @@ let handle_findlib_error = function
| exn -> | exn ->
raise exn raise exn
let check_for_camlp4_support () =
try
ignore (Fl_package_base.query "utop.camlp4");
true
with Fl_package_base.No_such_package("utop.camlp4", "") ->
Lwt_main.run (print_error "utop was built without camlp4 support.\n");
false
let set_syntax syntax =
match get_syntax (), syntax with
| Normal, Normal
| Camlp4o, Camlp4o
| Camlp4r, Camlp4r ->
()
| (Camlp4o | Camlp4r), _ ->
Lwt_main.run (print_error "Camlp4 already loaded, you cannot change the syntax now.\n")
| Normal, Camlp4o ->
if check_for_camlp4_support () then begin
Topfind.syntax "camlp4o";
Topfind.load_deeply ["utop.camlp4"];
set_syntax Camlp4o;
set_phrase_terminator ";;"
end
| Normal, Camlp4r ->
if check_for_camlp4_support () then begin
Topfind.syntax "camlp4r";
Topfind.load_deeply ["utop.camlp4"];
set_syntax Camlp4r;
set_phrase_terminator ";";
add_keyword "value"
end
let () =
Hashtbl.add
Toploop.directive_table
"camlp4o"
(Toploop.Directive_none
(fun () -> set_syntax Camlp4o));
Hashtbl.add
Toploop.directive_table
"camlp4r"
(Toploop.Directive_none
(fun () -> set_syntax Camlp4r))
(* +-----------------------------------------------------------------+
| Findlib stuff |
+-----------------------------------------------------------------+ *)
let topfind_log, set_topfind_log = S.create ~eq:(fun _ _ -> false) [] let topfind_log, set_topfind_log = S.create ~eq:(fun _ _ -> false) []
let () = let () =
@ -781,10 +726,6 @@ let split_words str =
let require packages = let require packages =
try try
let eff_packages = Findlib.package_deep_ancestors !Topfind.predicates packages in let eff_packages = Findlib.package_deep_ancestors !Topfind.predicates packages in
if get_syntax () = Normal && List.mem "camlp4" eff_packages then begin
set_syntax Camlp4o;
Topfind.load_deeply packages
end else
Topfind.load eff_packages Topfind.load eff_packages
with exn -> with exn ->
handle_findlib_error exn handle_findlib_error exn

28
src/lib/uTop.mli
View File

@ -101,34 +101,6 @@ val set_margin_function : (LTerm_geom.size -> int option) -> unit
]} ]}
*) *)
(** Syntax. *)
type syntax =
| Normal
(** No camlp4. *)
| Camlp4o
(** Camlp4, original syntax. *)
| Camlp4r
(** Camlp4, revised syntax. *)
val syntax : syntax signal
(** The syntax in use. If it is {!Camlp4o} or {!Camlp4r} quotations
are recognized. It is modified when you type [#camlp4o] or
[#camlp4r]. At the beginning it is {!Normal}. *)
val get_syntax : unit -> syntax
(** Returns the current value of {!syntax}. *)
val set_syntax : syntax -> unit
(** Changes the syntax used in utop. If the syntax is the same as
the current one, it does nothing. Otherwise it loads camlp4 and
setup several configuration variables.
Notes:
- the syntax can only be changed once. Once you set it to
{!Camlp4o} or {!Camlp4r} you cannot change it again.
- Typing [#camlp4o] is the same as calling [set_syntax Camlp4o].
- Typing [#camlp4r] is the same as calling [set_syntax Camlp4r]. *)
val phrase_terminator : string signal val phrase_terminator : string signal
(** The phrase terminator. It is ";;" by default and ";" when you (** The phrase terminator. It is ";;" by default and ";" when you
use revised syntax. *) use revised syntax. *)

39
src/lib/uTop_complete.ml
View File

@ -623,19 +623,6 @@ let replace x y set =
else else
set set
let global_names_revised () =
get_cached global_names_revised
(fun () ->
let set = global_names () in
replace "true" "True" (replace "false" "False" set))
let global_names syntax =
match syntax with
| UTop.Normal | UTop.Camlp4o ->
global_names ()
| UTop.Camlp4r ->
global_names_revised ()
let list_global_fields () = let list_global_fields () =
let rec loop acc = function let rec loop acc = function
| Env.Env_empty -> acc | Env.Env_empty -> acc
@ -873,15 +860,9 @@ and find_context_in_quotation = function
| Completion | | Completion |
+-----------------------------------------------------------------+ *) +-----------------------------------------------------------------+ *)
let complete ~syntax ~phrase_terminator ~input = let complete ~phrase_terminator ~input =
let true_name, false_name = let true_name, false_name = ("true", "false") in
match syntax with let tokens = UTop_lexer.lex_string input in
| UTop.Normal | UTop.Camlp4o ->
("true", "false")
| UTop.Camlp4r ->
("True", "False")
in
let tokens = UTop_lexer.lex_string syntax input in
(* Filter blanks and comments. *) (* Filter blanks and comments. *)
let tokens = filter tokens in let tokens = filter tokens in
match tokens with match tokens with
@ -918,7 +899,7 @@ let complete ~syntax ~phrase_terminator ~input =
let start = loc.idx1 + 1 + (String.length prefix - String.length last_prefix) in let start = loc.idx1 + 1 + (String.length prefix - String.length last_prefix) in
(start, List.map (fun w -> (w, "")) compls) (start, List.map (fun w -> (w, "")) compls)
| _ -> | _ ->
let set = global_names syntax in let set = global_names () in
let compls = lookup prefix (String_set.elements set) in let compls = lookup prefix (String_set.elements set) in
(loc.idx1 + 1, List.map (fun w -> (w, "")) compls) (loc.idx1 + 1, List.map (fun w -> (w, "")) compls)
end end
@ -1029,7 +1010,7 @@ let complete ~syntax ~phrase_terminator ~input =
| Some (Toploop.Directive_string _) -> [(" \"", "")] | Some (Toploop.Directive_string _) -> [(" \"", "")]
| Some (Toploop.Directive_bool _) -> [(true_name, phrase_terminator); (false_name, phrase_terminator)] | Some (Toploop.Directive_bool _) -> [(true_name, phrase_terminator); (false_name, phrase_terminator)]
| Some (Toploop.Directive_int _) -> [] | Some (Toploop.Directive_int _) -> []
| Some (Toploop.Directive_ident _) -> List.map (fun w -> (w, "")) (String_set.elements (global_names syntax)) | Some (Toploop.Directive_ident _) -> List.map (fun w -> (w, "")) (String_set.elements (global_names ()))
| None -> []) | None -> [])
| (Symbol "#", _) :: ((Lident dir | Uident dir), _) :: tokens -> begin | (Symbol "#", _) :: ((Lident dir | Uident dir), _) :: tokens -> begin
match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with
@ -1049,7 +1030,7 @@ let complete ~syntax ~phrase_terminator ~input =
| Some (Toploop.Directive_ident _) -> begin | Some (Toploop.Directive_ident _) -> begin
match parse_longident (List.rev tokens) with match parse_longident (List.rev tokens) with
| Some (Value, None, start, id) -> | Some (Value, None, start, id) ->
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (global_names syntax)))) (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (global_names ()))))
| Some (Value, Some longident, start, id) -> | Some (Value, Some longident, start, id) ->
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (names_of_module longident)))) (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (names_of_module longident))))
| _ -> | _ ->
@ -1065,7 +1046,7 @@ let complete ~syntax ~phrase_terminator ~input =
| None -> | None ->
(0, []) (0, [])
| Some [] -> | Some [] ->
(0, List.map (fun w -> (w, "")) (String_set.elements (String_set.union !UTop.keywords (global_names syntax)))) (0, List.map (fun w -> (w, "")) (String_set.elements (String_set.union !UTop.keywords (global_names ()))))
| Some tokens -> | Some tokens ->
match parse_method tokens with match parse_method tokens with
| Some (longident, meths, start, meth) -> | Some (longident, meths, start, meth) ->
@ -1085,7 +1066,7 @@ let complete ~syntax ~phrase_terminator ~input =
| None -> | None ->
(0, []) (0, [])
| Some (Value, None, start, id) -> | Some (Value, None, start, id) ->
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (String_set.union !UTop.keywords (global_names syntax))))) (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (String_set.union !UTop.keywords (global_names ())))))
| Some (Value, Some longident, start, id) -> | Some (Value, Some longident, start, id) ->
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (names_of_module longident)))) (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (names_of_module longident))))
| Some (Field, None, start, id) -> | Some (Field, None, start, id) ->
@ -1093,8 +1074,8 @@ let complete ~syntax ~phrase_terminator ~input =
| Some (Field, Some longident, start, id) -> | Some (Field, Some longident, start, id) ->
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (fields_of_module longident)))) (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (fields_of_module longident))))
let complete ~syntax ~phrase_terminator ~input = let complete ~phrase_terminator ~input =
try try
(complete ~syntax ~phrase_terminator ~input : int * (string * string) list) (complete ~phrase_terminator ~input : int * (string * string) list)
with Cmi_format.Error _ -> with Cmi_format.Error _ ->
(0, []) (0, [])

4
src/lib/uTop_complete.mli
View File

@ -9,8 +9,8 @@
(** OCaml completion. *) (** OCaml completion. *)
val complete : syntax : UTop.syntax -> phrase_terminator : string -> input : string -> int * (string * string) list val complete : phrase_terminator : string -> input : string -> int * (string * string) list
(** [complete ~syntax ~phrase_terminator ~input] returns the start (** [complete ~phrase_terminator ~input] returns the start
of the completed word in [input] and the list of possible of the completed word in [input] and the list of possible
completions with their suffixes. *) completions with their suffixes. *)

4
src/lib/uTop_lexer.mli
View File

@ -7,6 +7,6 @@
* This file is a part of utop. * This file is a part of utop.
*) *)
val lex_string : UTop.syntax -> string -> (UTop_token.t * UTop_token.location) list val lex_string : string -> (UTop_token.t * UTop_token.location) list
(** [lex_string syntax str] returns all the tokens contained in (** [lex_string str] returns all the tokens contained in
[str]. *) [str]. *)

96
src/lib/uTop_lexer.mll
View File

@ -75,36 +75,28 @@ let float_literal =
let symbolchar = let symbolchar =
['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
rule tokens syntax context idx acc = parse rule tokens context idx acc = parse
| eof | eof
{ (idx, None, List.rev acc) } { (idx, None, List.rev acc) }
| ('\n' | blank)+ | ('\n' | blank)+
{ let loc = lexeme_loc idx lexbuf in { let loc = lexeme_loc idx lexbuf in
tokens syntax context loc.idx2 ((Blanks, loc) :: acc) lexbuf } tokens context loc.idx2 ((Blanks, loc) :: acc) lexbuf }
| lident | lident
{ let src = lexeme lexbuf in { let src = lexeme lexbuf in
let loc = lexeme_loc idx lexbuf in let loc = lexeme_loc idx lexbuf in
let tok = let tok =
match syntax, src with match src with
| (UTop.Normal | UTop.Camlp4o), ("true" | "false") -> | ("true" | "false") ->
Constant src Constant src
| _ -> | _ ->
Lident src Lident src
in in
tokens syntax context loc.idx2 ((tok, loc) :: acc) lexbuf } tokens context loc.idx2 ((tok, loc) :: acc) lexbuf }
| uident | uident
{ let src = lexeme lexbuf in { let src = lexeme lexbuf in
let loc = lexeme_loc idx lexbuf in let loc = lexeme_loc idx lexbuf in
let tok = let tok = Uident src in
match syntax, src with tokens context loc.idx2 ((tok, loc) :: acc) lexbuf }
| UTop.Camlp4r, "True" ->
Constant "true"
| UTop.Camlp4r, "False" ->
Constant "false"
| _ ->
Uident src
in
tokens syntax context loc.idx2 ((tok, loc) :: acc) lexbuf }
| int_literal "l" | int_literal "l"
| int_literal "L" | int_literal "L"
| int_literal "n" | int_literal "n"
@ -112,18 +104,18 @@ rule tokens syntax context idx acc = parse
| float_literal | float_literal
{ let loc = lexeme_loc idx lexbuf in { let loc = lexeme_loc idx lexbuf in
let tok = Constant (lexeme lexbuf) in let tok = Constant (lexeme lexbuf) in
tokens syntax context loc.idx2 ((tok, loc) :: acc) lexbuf } tokens context loc.idx2 ((tok, loc) :: acc) lexbuf }
| '"' | '"'
{ let ofs = lexeme_start lexbuf in { let ofs = lexeme_start lexbuf in
let item, idx2= cm_string (idx + 1) lexbuf in let item, idx2= cm_string (idx + 1) lexbuf in
let loc = mkloc idx idx2 ofs (lexeme_end lexbuf) in let loc = mkloc idx idx2 ofs (lexeme_end lexbuf) in
tokens syntax context idx2 ((item, loc) :: acc) lexbuf } tokens context idx2 ((item, loc) :: acc) lexbuf }
| '{' (lowercase* as tag) '|' | '{' (lowercase* as tag) '|'
{ let ofs = lexeme_start lexbuf in { let ofs = lexeme_start lexbuf in
let delim_len = String.length tag + 2 in let delim_len = String.length tag + 2 in
let idx2, terminated = quoted_string (idx + delim_len) tag false lexbuf in let idx2, terminated = quoted_string (idx + delim_len) tag false lexbuf in
let loc = mkloc idx idx2 ofs (lexeme_end lexbuf) in let loc = mkloc idx idx2 ofs (lexeme_end lexbuf) in
tokens syntax context idx2 ((String (delim_len, terminated), loc) :: acc) lexbuf } tokens context idx2 ((String (delim_len, terminated), loc) :: acc) lexbuf }
| "'" [^'\'' '\\'] "'" | "'" [^'\'' '\\'] "'"
| "'\\" ['\\' '"' 'n' 't' 'b' 'r' ' ' '\'' 'x' '0'-'9'] eof | "'\\" ['\\' '"' 'n' 't' 'b' 'r' ' ' '\'' 'x' '0'-'9'] eof
| "'\\" ['\\' '"' 'n' 't' 'b' 'r' ' ' '\''] "'" | "'\\" ['\\' '"' 'n' 't' 'b' 'r' ' ' '\''] "'"
@ -131,37 +123,30 @@ rule tokens syntax context idx acc = parse
| "'\\" (['0'-'9'] ['0'-'9'] ['0'-'9'] | 'x' hexa_char hexa_char) eof | "'\\" (['0'-'9'] ['0'-'9'] ['0'-'9'] | 'x' hexa_char hexa_char) eof
| "'\\" (['0'-'9'] ['0'-'9'] ['0'-'9'] | 'x' hexa_char hexa_char) "'" | "'\\" (['0'-'9'] ['0'-'9'] ['0'-'9'] | 'x' hexa_char hexa_char) "'"
{ let loc = lexeme_loc idx lexbuf in { let loc = lexeme_loc idx lexbuf in
tokens syntax context loc.idx2 ((Char, loc) :: acc) lexbuf } tokens context loc.idx2 ((Char, loc) :: acc) lexbuf }
| "'\\" uchar | "'\\" uchar
{ let loc = mkloc idx (idx + 3) (lexeme_start lexbuf) (lexeme_end lexbuf) in { let loc = mkloc idx (idx + 3) (lexeme_start lexbuf) (lexeme_end lexbuf) in
tokens syntax context loc.idx2 ((Error, loc) :: acc) lexbuf } tokens context loc.idx2 ((Error, loc) :: acc) lexbuf }
| "(*)" | "(*)"
{ let loc = lexeme_loc idx lexbuf in { let loc = lexeme_loc idx lexbuf in
tokens syntax context loc.idx2 ((Comment (Comment_reg, true), loc) :: acc) lexbuf } tokens context loc.idx2 ((Comment (Comment_reg, true), loc) :: acc) lexbuf }
| "(**)" | "(**)"
{ let loc = lexeme_loc idx lexbuf in { let loc = lexeme_loc idx lexbuf in
tokens syntax context loc.idx2 ((Comment (Comment_doc, true), loc) :: acc) lexbuf } tokens context loc.idx2 ((Comment (Comment_doc, true), loc) :: acc) lexbuf }
| "(**" | "(**"
{ let ofs = lexeme_start lexbuf in { let ofs = lexeme_start lexbuf in
let idx2, terminated = comment (idx + 3) 0 false lexbuf in let idx2, terminated = comment (idx + 3) 0 false lexbuf in
let loc = mkloc idx idx2 ofs (lexeme_end lexbuf) in let loc = mkloc idx idx2 ofs (lexeme_end lexbuf) in
tokens syntax context idx2 ((Comment (Comment_doc, terminated), loc) :: acc) lexbuf } tokens context idx2 ((Comment (Comment_doc, terminated), loc) :: acc) lexbuf }
| "(*" | "(*"
{ let ofs = lexeme_start lexbuf in { let ofs = lexeme_start lexbuf in
let idx2, terminated = comment (idx + 2) 0 false lexbuf in let idx2, terminated = comment (idx + 2) 0 false lexbuf in
let loc = mkloc idx idx2 ofs (lexeme_end lexbuf) in let loc = mkloc idx idx2 ofs (lexeme_end lexbuf) in
tokens syntax context idx2 ((Comment (Comment_reg, terminated), loc) :: acc) lexbuf } tokens context idx2 ((Comment (Comment_reg, terminated), loc) :: acc) lexbuf }
| "" | ""
{ if syntax = UTop.Normal then { symbol context idx acc lexbuf }
symbol syntax context idx acc lexbuf
else
match context with
| Toplevel ->
camlp4_toplevel syntax context idx acc lexbuf
| Antiquot ->
camlp4_antiquot syntax context idx acc lexbuf }
and symbol syntax context idx acc = parse and symbol context idx acc = parse
| "(" | ")" | "(" | ")"
| "[" | "]" | "[" | "]"
| "{" | "}" | "{" | "}"
@ -172,7 +157,7 @@ and symbol syntax context idx acc = parse
| symbolchar+ | symbolchar+
{ let loc = lexeme_loc idx lexbuf in { let loc = lexeme_loc idx lexbuf in
let tok = Symbol (lexeme lexbuf) in let tok = Symbol (lexeme lexbuf) in
tokens syntax context loc.idx2 ((tok, loc) :: acc) lexbuf } tokens context loc.idx2 ((tok, loc) :: acc) lexbuf }
| uchar as uchar | uchar as uchar
{ let uChar= Zed_utf8.unsafe_extract uchar 0 in { let uChar= Zed_utf8.unsafe_extract uchar 0 in
if Zed_char.is_combining_mark uChar then if Zed_char.is_combining_mark uChar then
@ -186,10 +171,10 @@ and symbol syntax context idx acc = parse
| _-> tok | _-> tok
in in
let loc= { loc with ofs2= lexeme_end lexbuf } in let loc= { loc with ofs2= lexeme_end lexbuf } in
tokens syntax context loc.idx2 ((tok, loc) :: tl) lexbuf tokens context loc.idx2 ((tok, loc) :: tl) lexbuf
else else
let loc = mkloc idx (idx + 1) (lexeme_start lexbuf) (lexeme_end lexbuf) in let loc = mkloc idx (idx + 1) (lexeme_start lexbuf) (lexeme_end lexbuf) in
tokens syntax context loc.idx2 ((Error, loc) :: acc) lexbuf tokens context loc.idx2 ((Error, loc) :: acc) lexbuf
} }
and cm_string idx= parse and cm_string idx= parse
@ -211,23 +196,6 @@ and cm_string idx= parse
| eof | eof
{ (String (1, false), idx) } { (String (1, false), idx) }
and camlp4_toplevel syntax context idx acc = parse
| '<' (':' ident)? ('@' lident)? '<'
{ let ofs = lexeme_start lexbuf in
let idx2, items, terminated = quotation syntax 0 idx (idx + lexeme_size lexbuf) (lexeme_start lexbuf) false lexbuf in
let ofs2 = lexeme_end lexbuf in
tokens syntax context idx2
((Quotation (items, terminated), mkloc idx idx2 ofs ofs2) :: acc)
lexbuf }
| ""
{ symbol syntax context idx acc lexbuf }
and camlp4_antiquot syntax context idx acc = parse
| '$'
{ (idx + 1, Some (lexeme_loc idx lexbuf), List.rev acc) }
| ""
{ camlp4_toplevel syntax context idx acc lexbuf }
and comment idx depth combining= parse and comment idx depth combining= parse
| "(*" | "(*"
{ comment (idx + 2) (depth + 1) false lexbuf } { comment (idx + 2) (depth + 1) false lexbuf }
@ -302,15 +270,15 @@ and quoted_string idx tag combining= parse
quoted_string (idx + 1) tag true lexbuf quoted_string (idx + 1) tag true lexbuf
} }
and quotation syntax depth idx1 idx2 ofs1 combining= parse and quotation depth idx1 idx2 ofs1 combining= parse
| '<' (':' ident)? ('@' lident)? '<' | '<' (':' ident)? ('@' lident)? '<'
{ quotation syntax (depth + 1) idx1 (idx2 + lexeme_size lexbuf) ofs1 false lexbuf } { quotation (depth + 1) idx1 (idx2 + lexeme_size lexbuf) ofs1 false lexbuf }
| ">>" | ">>"
{ if depth = 0 then { if depth = 0 then
let loc = mkloc idx1 (idx2 + 2) ofs1 (lexeme_end lexbuf) in let loc = mkloc idx1 (idx2 + 2) ofs1 (lexeme_end lexbuf) in
(idx2 + 2, [(Quot_data, loc)], true) (idx2 + 2, [(Quot_data, loc)], true)
else else
quotation syntax (depth - 1) idx1 (idx2 + 2) ofs1 false lexbuf } quotation (depth - 1) idx1 (idx2 + 2) ofs1 false lexbuf }
| '$' | '$'
{ let quot_data_loc = { let quot_data_loc =
if idx1 = idx2 then if idx1 = idx2 then
@ -320,7 +288,7 @@ and quotation syntax depth idx1 idx2 ofs1 combining= parse
in in
let opening_loc = lexeme_loc idx2 lexbuf in let opening_loc = lexeme_loc idx2 lexbuf in
let idx, name = quotation_name (idx2 + 1) lexbuf in let idx, name = quotation_name (idx2 + 1) lexbuf in
let idx, closing_loc, items = tokens syntax Antiquot idx [] lexbuf in let idx, closing_loc, items = tokens Antiquot idx [] lexbuf in
let anti = { let anti = {
a_opening = opening_loc; a_opening = opening_loc;
a_closing = closing_loc; a_closing = closing_loc;
@ -329,7 +297,7 @@ and quotation syntax depth idx1 idx2 ofs1 combining= parse
} in } in
let ofs = lexeme_end lexbuf in let ofs = lexeme_end lexbuf in
let loc = mkloc opening_loc.idx1 idx opening_loc.ofs2 ofs in let loc = mkloc opening_loc.idx1 idx opening_loc.ofs2 ofs in
let idx, quot_items, terminated = quotation syntax depth idx idx ofs false lexbuf in let idx, quot_items, terminated = quotation depth idx idx ofs false lexbuf in
let quot_items = (Quot_anti anti, loc) :: quot_items in let quot_items = (Quot_anti anti, loc) :: quot_items in
match quot_data_loc with match quot_data_loc with
| Some loc -> | Some loc ->
@ -340,14 +308,14 @@ and quotation syntax depth idx1 idx2 ofs1 combining= parse
{ let uChar= Zed_utf8.unsafe_extract uchar 0 in { let uChar= Zed_utf8.unsafe_extract uchar 0 in
if not combining then if not combining then
if Zed_char.is_combining_mark uChar then if Zed_char.is_combining_mark uChar then
quotation syntax depth idx1 (idx2 + 1) ofs1 false lexbuf quotation depth idx1 (idx2 + 1) ofs1 false lexbuf
else else
quotation syntax depth idx1 (idx2 + 1) ofs1 true lexbuf quotation depth idx1 (idx2 + 1) ofs1 true lexbuf
else else
if Zed_char.is_combining_mark uChar then if Zed_char.is_combining_mark uChar then
quotation syntax depth idx1 idx2 ofs1 true lexbuf quotation depth idx1 idx2 ofs1 true lexbuf
else else
quotation syntax depth idx1 (idx2 + 1) ofs1 true lexbuf quotation depth idx1 (idx2 + 1) ofs1 true lexbuf
} }
| eof | eof
{ if idx1 = idx2 then { if idx1 = idx2 then
@ -366,7 +334,7 @@ and quotation_name idx = parse
{ (idx, None) } { (idx, None) }
{ {
let lex_string syntax str = let lex_string str =
let _, _, items = tokens syntax Toplevel 0 [] (Lexing.from_string str) in let _, _, items = tokens Toplevel 0 [] (Lexing.from_string str) in
items items
} }

7
src/lib/uTop_main.ml
View File

@ -224,7 +224,7 @@ class read_phrase ~term = object(self)
styled.(i) <- (ch, LTerm_style.merge token_style style) styled.(i) <- (ch, LTerm_style.merge token_style style)
done done
in in
UTop_styles.stylise stylise (UTop_lexer.lex_string (UTop.get_syntax ()) (Zed_string.to_utf8 (LTerm_text.to_string styled))); UTop_styles.stylise stylise (UTop_lexer.lex_string (Zed_string.to_utf8 (LTerm_text.to_string styled)));
if not last then if not last then
(* Parenthesis matching. *) (* Parenthesis matching. *)
@ -249,7 +249,6 @@ class read_phrase ~term = object(self)
method! completion = method! completion =
let pos, words = let pos, words =
UTop_complete.complete UTop_complete.complete
~syntax:(UTop.get_syntax ())
~phrase_terminator:(UTop.get_phrase_terminator ()) ~phrase_terminator:(UTop.get_phrase_terminator ())
~input:(Zed_string.to_utf8 (Zed_rope.to_string self#input_prev)) ~input:(Zed_string.to_utf8 (Zed_rope.to_string self#input_prev))
in in
@ -306,7 +305,7 @@ let render_out_phrase term string =
styled.(i) <- (ch, LTerm_style.merge token_style style) styled.(i) <- (ch, LTerm_style.merge token_style style)
done done
in in
UTop_styles.stylise stylise (UTop_lexer.lex_string (UTop.get_syntax ()) string); UTop_styles.stylise stylise (UTop_lexer.lex_string string);
LTerm.fprints term styled LTerm.fprints term styled
end end
@ -1088,7 +1087,6 @@ module Emacs(M : sig end) = struct
let input = read_data () in let input = read_data () in
let _, words = let _, words =
UTop_complete.complete UTop_complete.complete
~syntax:(UTop.get_syntax ())
~phrase_terminator:(UTop.get_phrase_terminator ()) ~phrase_terminator:(UTop.get_phrase_terminator ())
~input ~input
in in
@ -1100,7 +1098,6 @@ module Emacs(M : sig end) = struct
let input = read_data () in let input = read_data () in
let start, words = let start, words =
UTop_complete.complete UTop_complete.complete
~syntax:(UTop.get_syntax ())
~phrase_terminator:(UTop.get_phrase_terminator ()) ~phrase_terminator:(UTop.get_phrase_terminator ())
~input ~input
in in

5
src/top/utop.el
View File

@ -211,11 +211,6 @@ to add the newline character if it is not accepted).")
"List of packages to load when visiting OCaml buffer. "List of packages to load when visiting OCaml buffer.
Useful as file variable.")) Useful as file variable."))
(make-variable-buffer-local
(defvar utop-ocaml-preprocessor nil
"Name of preprocesor. Currently supported camlp4o, camlp4r.
Useful as file variable."))
(defvar utop-next-phrase-beginning 'utop-compat-next-phrase-beginning (defvar utop-next-phrase-beginning 'utop-compat-next-phrase-beginning
"The function used to find the beginning of the next phrase.") "The function used to find the beginning of the next phrase.")