Skip to content

Commit f4f67bd

Browse files
committed
Update syntax submodule
Includes some tweaks that are needed for subsequent error message tunings
1 parent e1f9beb commit f4f67bd

File tree

2 files changed

+62
-25
lines changed

2 files changed

+62
-25
lines changed

lib/4.06.1/whole_compiler.ml

Lines changed: 61 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -416031,13 +416031,11 @@ end
416031416031
module Res_minibuffer : sig
416032416032
#1 "res_minibuffer.mli"
416033416033
type t
416034-
val add_char : t -> char -> unit
416035416034
val add_string : t -> string -> unit
416036416035
val contents : t -> string
416037416036
val create : int -> t
416038416037
val flush_newline : t -> unit
416039-
val length : t -> int
416040-
val unsafe_get : t -> int -> char
416038+
416041416039
end = struct
416042416040
#1 "res_minibuffer.ml"
416043416041
type t = {
@@ -416053,11 +416051,6 @@ let create n =
416053416051

416054416052
let contents b = Bytes.sub_string b.buffer 0 b.position
416055416053

416056-
let unsafe_get b ofs =
416057-
Bytes.unsafe_get b.buffer ofs
416058-
416059-
let length b = b.position
416060-
416061416054
(* Can't be called directly, don't add to the interface *)
416062416055
let resize_internal b more =
416063416056
let len = b.length in
@@ -416095,6 +416088,7 @@ let flush_newline b =
416095416088
done;
416096416089
b.position <- !position;
416097416090
add_char b '\n'
416091+
416098416092
end
416099416093
module Res_doc : sig
416100416094
#1 "res_doc.mli"
@@ -416349,10 +416343,6 @@ let toString ~width doc =
416349416343
end
416350416344
in
416351416345
process ~pos:0 [] [0, Flat, doc];
416352-
416353-
let len = MiniBuffer.length buffer in
416354-
if len > 0 && MiniBuffer.unsafe_get buffer (len - 1) != '\n' then
416355-
MiniBuffer.add_char buffer '\n';
416356416346
MiniBuffer.contents buffer
416357416347

416358416348

@@ -418599,6 +418589,8 @@ and walkExprArgument (_argLabel, expr) t comments =
418599418589
let (before, after) = partitionLeadingTrailing comments longident.loc in
418600418590
attach t.leading longident.loc before;
418601418591
attach t.trailing longident.loc after
418592+
| Pmod_structure [] ->
418593+
attach t.inside modExpr.pmod_loc comments
418602418594
| Pmod_structure structure ->
418603418595
walkStructure structure t comments
418604418596
| Pmod_extension extension ->
@@ -418692,6 +418684,8 @@ and walkExprArgument (_argLabel, expr) t comments =
418692418684
let (leading, trailing) = partitionLeadingTrailing comments longident.loc in
418693418685
attach t.leading longident.loc leading;
418694418686
attach t.trailing longident.loc trailing;
418687+
| Pmty_signature [] ->
418688+
attach t.inside modType.pmty_loc comments
418695418689
| Pmty_signature signature ->
418696418690
walkSignature signature t comments
418697418691
| Pmty_extension extension ->
@@ -419992,10 +419986,10 @@ let explain t =
419992419986
end
419993419987
| Expected {context; token = t} ->
419994419988
let hint = match context with
419995-
| Some grammar -> "It signals the start of " ^ (Grammar.toString grammar)
419989+
| Some grammar -> " It signals the start of " ^ (Grammar.toString grammar)
419996419990
| None -> ""
419997419991
in
419998-
"Did you forget a `" ^ (Token.toString t) ^ "` here? " ^ hint
419992+
"Did you forget a `" ^ (Token.toString t) ^ "` here?" ^ hint
419999419993
| Unexpected {token = t; context = breadcrumbs} ->
420000419994
let name = (Token.toString t) in
420001419995
begin match breadcrumbs with
@@ -420062,15 +420056,24 @@ let make ~startPos ~endPos category = {
420062420056
}
420063420057

420064420058
let printReport diagnostics src =
420059+
let rec print diagnostics src =
420060+
match diagnostics with
420061+
| [] -> ()
420062+
| d::rest ->
420063+
Res_diagnostics_printing_utils.Super_location.super_error_reporter
420064+
Format.err_formatter
420065+
~src
420066+
~startPos:d.startPos
420067+
~endPos:d.endPos
420068+
~msg:(explain d);
420069+
begin match rest with
420070+
| [] -> ()
420071+
| _ -> Format.fprintf Format.err_formatter "@."
420072+
end;
420073+
print rest src
420074+
in
420065420075
Format.fprintf Format.err_formatter "@[<v>";
420066-
List.rev diagnostics |> List.iter (fun d ->
420067-
Res_diagnostics_printing_utils.Super_location.super_error_reporter
420068-
Format.err_formatter
420069-
~src
420070-
~startPos:d.startPos
420071-
~endPos:d.endPos
420072-
~msg:(explain d)
420073-
);
420076+
print (List.rev diagnostics) src;
420074420077
Format.fprintf Format.err_formatter "@]@."
420075420078

420076420079
let unexpected token context =
@@ -422257,6 +422260,23 @@ and printModType modType cmtTbl =
422257422260
printAttributes ~loc:longident.loc modType.pmty_attributes cmtTbl;
422258422261
printLongidentLocation longident cmtTbl
422259422262
]
422263+
| Pmty_signature [] ->
422264+
let shouldBreak =
422265+
modType.pmty_loc.loc_start.pos_lnum < modType.pmty_loc.loc_end.pos_lnum
422266+
in
422267+
Doc.breakableGroup ~forceBreak:shouldBreak (
422268+
Doc.concat [
422269+
Doc.lbrace;
422270+
Doc.indent (
422271+
Doc.concat [
422272+
Doc.softLine;
422273+
printCommentsInside cmtTbl modType.pmty_loc;
422274+
];
422275+
);
422276+
Doc.softLine;
422277+
Doc.rbrace;
422278+
]
422279+
)
422260422280
| Pmty_signature signature ->
422261422281
let signatureDoc = Doc.breakableGroup ~forceBreak:true (
422262422282
Doc.concat [
@@ -426352,6 +426372,23 @@ and printModExpr modExpr cmtTbl =
426352426372
let doc = match modExpr.pmod_desc with
426353426373
| Pmod_ident longidentLoc ->
426354426374
printLongidentLocation longidentLoc cmtTbl
426375+
| Pmod_structure [] ->
426376+
let shouldBreak =
426377+
modExpr.pmod_loc.loc_start.pos_lnum < modExpr.pmod_loc.loc_end.pos_lnum
426378+
in
426379+
Doc.breakableGroup ~forceBreak:shouldBreak (
426380+
Doc.concat [
426381+
Doc.lbrace;
426382+
Doc.indent (
426383+
Doc.concat [
426384+
Doc.softLine;
426385+
printCommentsInside cmtTbl modExpr.pmod_loc;
426386+
];
426387+
);
426388+
Doc.softLine;
426389+
Doc.rbrace;
426390+
]
426391+
)
426355426392
| Pmod_structure structure ->
426356426393
Doc.breakableGroup ~forceBreak:true (
426357426394
Doc.concat [
@@ -426644,12 +426681,12 @@ let printImplementation ~width (s: Parsetree.structure) ~comments =
426644426681
(* CommentTable.log cmtTbl; *)
426645426682
let doc = printStructure s cmtTbl in
426646426683
(* Doc.debug doc; *)
426647-
Doc.toString ~width doc
426684+
Doc.toString ~width doc ^ "\n"
426648426685

426649426686
let printInterface ~width (s: Parsetree.signature) ~comments =
426650426687
let cmtTbl = CommentTable.make () in
426651426688
CommentTable.walkSignature s cmtTbl comments;
426652-
Doc.toString ~width (printSignature s cmtTbl)
426689+
Doc.toString ~width (printSignature s cmtTbl) ^ "\n"
426653426690

426654426691
end
426655426692
module Res_core : sig

0 commit comments

Comments
 (0)