this repo has no description
Better lexer
+89
-87
+16
-14
lib/impl.ml
+16
-14
lib/impl.ml
···
9
9
10
10
let is_mangled_broken orig src =
11
11
String.length orig <> String.length src
12
-
(* ||
13
-
Seq.exists2 (fun c c' ->
14
-
(c' = ' ' || c = c')) (String.to_seq orig) (String.to_seq src) *)
12
+
||
13
+
Seq.exists2 (fun c c' ->
14
+
c <> c' && c' <> ' ') (String.to_seq orig) (String.to_seq src)
15
15
16
16
let mangle_toplevel is_toplevel orig_source deps =
17
17
let src =
···
24
24
else begin
25
25
try
26
26
let s = String.sub orig_source 2 (String.length orig_source - 2) in
27
-
let list = Ocamltop.parse_toplevel s in
28
-
let buff = Buffer.create 100 in
29
-
List.iter (fun (phr, junk, output) ->
30
-
Printf.bprintf buff " %s%s\n" phr (String.make (String.length junk) ' ');
31
-
let s = List.map (fun x ->
32
-
Printf.sprintf "%s" (String.make (String.length x) ' ')) output
33
-
in
34
-
Buffer.add_string buff (String.concat "\n" s);
35
-
()) list;
36
-
Buffer.contents buff
27
+
let list =
28
+
try Ocamltop.parse_toplevel s with _ -> Ocamltop.fallback_parse_toplevel s in
29
+
let lines =List.map (fun (phr, junk, output) ->
30
+
let l1 = Printf.sprintf " %s%s" phr (String.make (String.length junk) ' ') in
31
+
match output with
32
+
| [] -> l1
33
+
| _ ->
34
+
let s = List.map (fun x ->
35
+
String.make (String.length x) ' ') output
36
+
in
37
+
(String.concat "\n" (l1 :: s));
38
+
) list in
39
+
String.concat "\n" lines
37
40
with e ->
38
41
Logs.err (fun m -> m "Error in mangle_toplevel: %s" (Printexc.to_string e));
39
42
let ppf = Format.err_formatter in
···
51
54
Printf.printf "Warning: mangled source is broken\n%!";
52
55
Printf.printf "orig length: %d\n%!" (String.length orig_source);
53
56
Printf.printf "src length: %d\n%!" (String.length src);
54
-
failwith "broken"
55
57
);
56
58
line1, src
57
59
+14
-16
lib/ocamltop.ml
+14
-16
lib/ocamltop.ml
···
9
9
p := !p + len'';
10
10
len''
11
11
12
-
let parse_toplevel s =
13
-
let legacy_warn =
14
-
let b = ref false in
15
-
fun () ->
16
-
if !b
17
-
then ()
18
-
else
19
-
(Logs.warn (fun m -> m "Warning: Legacy toplevel output detected");
20
-
b := true)
12
+
let fallback_parse_toplevel s =
13
+
Printf.printf "fallback parser\n%!";
14
+
let lexbuf = Lexing.from_string s in
15
+
let rec loop pos =
16
+
let _phr = Toplexer.fallback_expression lexbuf in
17
+
Printf.printf "Got phrase\n%!";
18
+
let new_pos = Lexing.lexeme_end lexbuf in
19
+
let phr = String.sub s pos (new_pos - pos) in
20
+
let (junk, (cont, output)) = Toplexer.entry lexbuf in
21
+
let new_pos = Lexing.lexeme_end lexbuf in
22
+
if cont then (phr, junk, output) :: loop new_pos else [ (phr, junk, output) ]
21
23
in
24
+
loop 0
22
25
26
+
let parse_toplevel s =
23
27
let lexbuf = Lexing.from_string s in
24
28
let rec loop pos =
25
29
let _phr = !Toploop.parse_toplevel_phrase lexbuf in
26
30
let new_pos = Lexing.lexeme_end lexbuf in
27
31
let phr = String.sub s pos (new_pos - pos) in
28
-
let (junk, (cont, is_legacy, output)) = Toplexer.entry lexbuf in
29
-
let output =
30
-
if is_legacy then begin
31
-
legacy_warn ();
32
-
output
33
-
end else output
34
-
in
32
+
let (junk, (cont, output)) = Toplexer.entry lexbuf in
35
33
let new_pos = Lexing.lexeme_end lexbuf in
36
34
if cont then (phr, junk, output) :: loop new_pos else [ (phr, junk, output) ]
37
35
in
+17
-23
lib/toplexer.mll
+17
-23
lib/toplexer.mll
···
1
1
{ }
2
2
3
-
rule entry = parse
3
+
(* TODO: implement strings, comments, etc, to ignore ';;' in them *)
4
+
rule fallback_expression = shortest
5
+
| (_ as expr)* ";;" {
6
+
expr
7
+
}
8
+
| (_ as expr)* eof {
9
+
expr
10
+
}
11
+
12
+
and entry = parse
4
13
| ((_ # '\n')* as junk) "\n" {
5
14
(junk, line_prefix [] lexbuf)
6
15
}
7
-
| ((_ # '\n')* as junk) {
8
-
(junk, (false, false, []))
16
+
| ((_ # '\n')* as junk) eof {
17
+
(junk, (false, []))
9
18
}
10
-
| ((_ # '\n')* as junk) eof { (junk, (false, false, [])) }
11
19
12
20
and line_prefix acc = parse
13
-
| " " {
14
-
line acc lexbuf
15
-
}
16
21
| "# " {
17
-
true, false, List.rev acc
22
+
true, List.rev acc
18
23
}
19
24
| _ as c {
20
25
output_line_legacy c acc lexbuf
21
26
}
22
27
| eof {
23
-
false, false, List.rev acc
24
-
}
25
-
26
-
and line acc = parse
27
-
| ((_ # '\n')* as line) "\n" {
28
-
line_prefix ((" "^line) :: acc) lexbuf
29
-
}
30
-
| ((_ # '\n')* as line) eof {
31
-
false, false, List.rev ((" "^line) :: acc)
28
+
false, List.rev ("" :: acc)
32
29
}
33
30
34
31
and output_line_legacy c acc = parse
35
32
| ((_ # '\n')* as line) "\n# " {
36
-
true, true, List.rev ((String.make 1 c ^ line) :: acc)
33
+
true, List.rev ((String.make 1 c ^ line) :: acc)
37
34
}
38
35
| ((_ # '\n')* as line) "\n" (_ as c') {
39
36
output_line_legacy c' ((String.make 1 c ^ line) :: acc) lexbuf
40
37
}
41
38
| ((_ # '\n')* as line) "\n" eof {
42
-
false, true, List.rev ("" :: (String.make 1 c ^ line) :: acc)
39
+
false, List.rev ("" :: (String.make 1 c ^ line) :: acc)
43
40
}
44
41
| (_ # '\n')* as line eof {
45
-
false, true, List.rev ((String.make 1 c ^ line) :: acc)
46
-
}
47
-
| eof {
48
-
false, true, List.rev ((String.make 1 c) :: acc)
42
+
false, List.rev ((String.make 1 c ^ line) :: acc)
49
43
}
50
44
-1
test/cram/simple.t/run.t
-1
test/cram/simple.t/run.t
+42
-33
test/libtest/parse_test.ml
+42
-33
test/libtest/parse_test.ml
···
18
18
19
19
let%expect_test _ =
20
20
check "# foo;; junk\n bar\n# baz;;\n moo\n# unterminated;; foo\n";
21
-
[%expect.unreachable]
22
-
[@@expect.uncaught_exn {|
23
-
(* CR expect_test_collector: This test expectation appears to contain a backtrace.
24
-
This is strongly discouraged as backtraces are fragile.
25
-
Please change this test to not include a backtrace. *)
21
+
[%expect{|
22
+
input:
23
+
# foo;; junk
24
+
bar
25
+
# baz;;
26
+
moo
27
+
# unterminated;; foo
26
28
27
-
(Failure broken)
28
-
Called from unknown location
29
-
Called from unknown location
30
-
Called from unknown location
31
-
Called from unknown location
29
+
output:
30
+
foo;;
32
31
33
-
Trailing output
34
-
---------------
35
-
Warning: mangled source is broken
36
-
orig length: 54
37
-
src length: 52 |}]
32
+
baz;;
33
+
34
+
unterminated;;
35
+
36
+
output mapped:
37
+
..foo;;.....
38
+
.....
39
+
..baz;;
40
+
.....
41
+
..unterminated;;.... |}]
38
42
39
43
let%expect_test _ =
40
44
check "# 1+2;;\n- 3 : int\n \n";
···
56
60
57
61
let%expect_test _ =
58
62
check "# 1+2;;";
59
-
[%expect.unreachable]
60
-
[@@expect.uncaught_exn {|
61
-
(* CR expect_test_collector: This test expectation appears to contain a backtrace.
62
-
This is strongly discouraged as backtraces are fragile.
63
-
Please change this test to not include a backtrace. *)
64
-
65
-
(Failure broken)
66
-
Called from unknown location
67
-
Called from unknown location
68
-
Called from unknown location
69
-
Called from unknown location
70
-
71
-
Trailing output
72
-
---------------
73
-
Warning: mangled source is broken
74
-
orig length: 7
75
-
src length: 8 |}]
63
+
[%expect{|
64
+
input:
65
+
# 1+2;;
66
+
output:
67
+
1+2;;
68
+
output mapped:
69
+
..1+2;; |}]
76
70
77
71
let%expect_test _ =
78
72
check "# 1+2;;\nx\n";
···
87
81
88
82
output mapped:
89
83
..1+2;;
90
-
. |}]
84
+
. |}]
85
+
86
+
let%expect_test _ =
87
+
check "# let ;;\n foo";
88
+
[%expect "
89
+
fallback parser
90
+
Got phrase
91
+
input:
92
+
# let ;;
93
+
foo
94
+
output:
95
+
let ;;
96
+
97
+
output mapped:
98
+
..let.;;
99
+
....."]