···
mutable allow_simple_key : bool;
mutable leading_whitespace : bool; (** True when at start of line (only whitespace seen) *)
mutable document_has_content : bool; (** True if we've emitted content tokens in current document *)
32
+
mutable adjacent_value_allowed_at : Position.t option; (** Position where adjacent : is allowed *)
33
+
mutable pending_value : bool; (** True if we've emitted a KEY and are waiting for VALUE *)
···
leading_whitespace = true; (* Start at beginning of stream *)
document_has_content = false;
51
+
adjacent_value_allowed_at = None;
52
+
pending_value = false;
let of_string s = create (Input.of_string s)
···
(** Get current indent level *)
match t.indent_stack with
| { indent; _ } :: _ -> indent
(** Skip whitespace to end of line, checking for valid comments.
···
if Input.next_is (( = ) '#') t.input then begin
(* Validate: comment must be preceded by whitespace or be at start of line *)
if not !has_whitespace then begin
82
-
(* Check if we're at the start of input or after a line break *)
86
+
(* Check if we're at the start of input or after whitespace (blank or line break) *)
match Input.peek_back t.input with
| None -> () (* Start of input - OK *)
85
-
| Some c when Input.is_break c -> () (* After line break - OK *)
89
+
| Some c when Input.is_whitespace c -> () (* After whitespace - OK *)
(* Comment not preceded by whitespace - ERROR *)
Error.raise_at (Input.mark t.input) Invalid_comment
···
(* Check for tabs used as indentation in block context *)
(match Input.peek t.input with
| Some '\t' when t.flow_level = 0 && t.leading_whitespace &&
110
-
(column t - 1) <= current_indent t ->
114
+
(column t - 1) < current_indent t ->
(* Tab found in indentation zone - this is invalid *)
(* Skip to end of line to check if line has content *)
let start_pos = Input.mark t.input in
···
else if t.flow_level > 0 && Input.next_is_whitespace t.input then begin
132
-
ignore (Input.next t.input);
133
-
skip_to_next_token t
136
+
(* In flow context, skip all whitespace including line breaks *)
137
+
if Input.next_is_break t.input then begin
138
+
Input.consume_break t.input;
139
+
(* Allow simple keys after line breaks in flow context *)
140
+
t.allow_simple_key <- true;
141
+
skip_to_next_token t
143
+
ignore (Input.next t.input);
144
+
skip_to_next_token t
(** Roll the indentation level *)
···
(** Scan tag suffix (after handle) *)
268
+
let is_hex_digit c =
269
+
(c >= '0' && c <= '9') || (c >= 'A' && c <= 'F') || (c >= 'a' && c <= 'f')
273
+
| '0'..'9' -> Char.code c - Char.code '0'
274
+
| 'A'..'F' -> Char.code c - Char.code 'A' + 10
275
+
| 'a'..'f' -> Char.code c - Char.code 'a' + 10
let buf = Buffer.create 32 in
match Input.peek t.input with
282
+
(* Percent-encoded character *)
283
+
ignore (Input.next t.input);
284
+
(match Input.peek t.input, Input.peek_nth t.input 1 with
285
+
| Some c1, Some c2 when is_hex_digit c1 && is_hex_digit c2 ->
286
+
ignore (Input.next t.input);
287
+
ignore (Input.next t.input);
288
+
let code = (hex_val c1) * 16 + (hex_val c2) in
289
+
Buffer.add_char buf (Char.chr code);
292
+
(* Invalid percent encoding - keep the % *)
293
+
Buffer.add_char buf '%';
| Some c when not (Input.is_whitespace c) &&
not (Input.is_flow_indicator c) ->
···
let start = Input.mark t.input in
ignore (Input.next t.input); (* consume opening double-quote *)
let buf = Buffer.create 64 in
435
+
let whitespace = Buffer.create 16 in (* Track pending whitespace *)
437
+
let flush_whitespace () =
438
+
if Buffer.length whitespace > 0 then begin
439
+
Buffer.add_buffer buf whitespace;
440
+
Buffer.clear whitespace
match Input.peek t.input with
| None -> Error.raise_at start Unclosed_double_quote
448
+
(* Flush trailing whitespace before closing quote to preserve it *)
449
+
flush_whitespace ();
ignore (Input.next t.input)
451
+
| Some ' ' | Some '\t' as c_opt ->
452
+
(* Track whitespace - don't add to buf yet *)
453
+
let c = match c_opt with Some c -> c | None -> assert false in
454
+
Buffer.add_char whitespace c;
455
+
ignore (Input.next t.input);
458
+
(* Escape sequence - this is non-whitespace content *)
459
+
flush_whitespace (); (* Commit any pending whitespace *)
ignore (Input.next t.input);
(match Input.peek t.input with
| None -> Error.raise_at start (Invalid_escape_sequence "\\<EOF>")
···
ignore (Input.next t.input);
Buffer.add_string buf (decode_hex t 8)
| Some '\n' | Some '\r' ->
435
-
(* Line continuation *)
490
+
(* Line continuation escape *)
Input.consume_break t.input;
while Input.next_is_blank t.input do
ignore (Input.next t.input)
···
(Invalid_escape_sequence (Printf.sprintf "\\%c" c)));
| Some '\n' | Some '\r' ->
445
-
(* Per YAML spec: discard trailing whitespace before line break *)
446
-
let len = Buffer.length buf in
447
-
let rec trim_end i =
449
-
else match Buffer.nth buf i with
450
-
| ' ' | '\t' -> trim_end (i - 1)
453
-
Buffer.truncate buf (trim_end (len - 1));
500
+
(* Line break: discard any pending trailing whitespace *)
501
+
Buffer.clear whitespace;
Input.consume_break t.input;
(* Count consecutive line breaks (empty lines) *)
let empty_lines = ref 0 in
···
532
+
(* Non-whitespace character *)
533
+
flush_whitespace (); (* Commit any pending whitespace *)
ignore (Input.next t.input);
···
let start = Input.mark t.input in
let in_flow = t.flow_level > 0 in
let indent = current_indent t in
519
-
(* Validate flow collection indentation *)
520
-
if in_flow && (column t) < t.flow_indent then
569
+
(* In flow context, scalars must be indented more than the current block indent.
570
+
This ensures that content at block indent or less ends the flow context. *)
571
+
if in_flow && (column t - 1) < indent then
Error.raise_at start Invalid_flow_indentation;
let buf = Buffer.create 64 in
let spaces = Buffer.create 16 in
575
+
let whitespace = Buffer.create 16 in (* Track whitespace within a line *)
let leading_blanks = ref false in
match Input.peek t.input with
581
+
| Some c when Input.is_blank c && can_continue_plain t c ~in_flow ->
582
+
(* Blank character within a line - save to whitespace buffer *)
583
+
Buffer.add_char whitespace c;
584
+
ignore (Input.next t.input);
| Some c when can_continue_plain t c ~in_flow ->
530
-
(* can_continue_plain already handles # correctly - it returns false
531
-
when # is preceded by whitespace (making it a comment indicator) *)
587
+
(* Non-blank character - process any pending breaks/whitespace first *)
if Buffer.length spaces > 0 then begin
if !leading_blanks then begin
···
Buffer.add_buffer buf spaces;
603
+
(* Add any pending whitespace from within the line *)
604
+
if Buffer.length whitespace > 0 then begin
605
+
Buffer.add_buffer buf whitespace;
606
+
Buffer.clear whitespace
608
+
(* Add the character *)
ignore (Input.next t.input);
···
(* Check for line continuation *)
558
-
if not in_flow && Input.next_is_break t.input then begin
620
+
if Input.next_is_break t.input then begin
621
+
(* Discard any trailing whitespace from the current line *)
622
+
Buffer.clear whitespace;
(* Save the line break *)
if !leading_blanks then begin
(* We already had a break - this is an additional break (empty line) *)
···
Input.consume_break t.input;
570
-
(* Line break in block context allows simple key *)
571
-
t.allow_simple_key <- true;
634
+
(* Line break allows simple key in both block and flow contexts *)
636
+
t.allow_simple_key <- true;
637
+
if not in_flow then
638
+
t.allow_simple_key <- true;
(* Skip leading blanks on the next line *)
while Input.next_is_blank t.input do
ignore (Input.next t.input)
let col = (Input.position t.input).column in
(* Check indentation - stop if we're at or before the containing block's indent *)
578
-
if not in_flow && col <= indent then
579
-
() (* Stop - dedented or at parent level *)
645
+
(* However, allow empty lines (line breaks) to continue even if dedented *)
646
+
if Input.next_is_break t.input then
647
+
scan_lines () (* Empty line - continue *)
648
+
else if not in_flow && col <= indent then
649
+
() (* Stop - dedented or at parent level in block context *)
else if Input.at_document_boundary t.input then
() (* Stop - document boundary *)
···
let buf = Buffer.create 256 in
let trailing_breaks = Buffer.create 16 in
725
+
let leading_blank = ref false in (* Was the previous line "more indented"? *)
(* Skip to content indentation, skipping empty lines.
Returns the number of spaces actually skipped (important for detecting dedentation). *)
···
(* Check if we found a break (empty line) or content *)
(match Input.peek_nth t.input (!idx) with
| None | Some '\n' | Some '\r' ->
689
-
(* Empty line - consume all blanks and break *)
690
-
while Input.next_is_blank t.input do
691
-
ignore (Input.next t.input)
760
+
(* Empty line - preserve spaces for literal scalars *)
761
+
if literal then begin
762
+
while Input.next_is_blank t.input do
763
+
Buffer.add_char trailing_breaks ' ';
764
+
ignore (Input.next t.input)
767
+
while Input.next_is_blank t.input do
768
+
ignore (Input.next t.input)
Buffer.add_char trailing_breaks '\n';
Input.consume_break t.input;
skip_to_content_indent ()
···
let line_indent = spaces_skipped + !extra_spaces in
(* Determine content indent from first content line (implicit case) *)
829
+
let first_line = !content_indent = 0 in
if !content_indent = 0 then begin
if line_indent <= base_indent then begin
(* No content - restore position conceptually *)
···
(* Dedented - done with content *)
842
+
(* Check if current line is "more indented" (has extra indent beyond content_indent) *)
843
+
let trailing_blank = line_indent > !content_indent in
(* Add trailing breaks to buffer *)
if Buffer.length buf > 0 then begin
if Buffer.length trailing_breaks > 0 then begin
Buffer.add_buffer buf trailing_breaks
769
-
let breaks = Buffer.contents trailing_breaks in
770
-
if String.length breaks = 1 then
771
-
Buffer.add_char buf ' '
773
-
Buffer.add_substring buf breaks 1 (String.length breaks - 1)
851
+
(* Folded scalar: fold only if both previous and current lines are not more-indented *)
852
+
if not !leading_blank && not trailing_blank then begin
853
+
let breaks = Buffer.contents trailing_breaks in
854
+
if String.length breaks = 1 then
855
+
Buffer.add_char buf ' '
857
+
Buffer.add_substring buf breaks 1 (String.length breaks - 1)
859
+
(* Preserve breaks for more-indented lines *)
860
+
Buffer.add_buffer buf trailing_breaks
end else if not literal then
···
Buffer.add_buffer buf trailing_breaks;
Buffer.clear trailing_breaks;
781
-
(* Add extra indentation for literal *)
782
-
if literal then begin
783
-
for _ = !content_indent + 1 to line_indent do
869
+
(* Add extra indentation for literal or more-indented folded lines *)
870
+
(* On the first line (when determining content_indent), we've already consumed all spaces,
871
+
so we should NOT add any back. On subsequent lines, we add only the spaces beyond content_indent. *)
872
+
if not first_line && (literal || (!extra_spaces > 0 && not literal)) then begin
873
+
for _ = 1 to !extra_spaces do
···
Buffer.add_char trailing_breaks '\n';
Input.consume_break t.input
889
+
(* Update leading_blank for next iteration *)
890
+
leading_blank := trailing_blank;
···
ignore (Input.next t.input)
843
-
let span = Span.make ~start ~stop:(Input.mark t.input) in
(* Version directive: %YAML 1.2 *)
···
let span = Span.make ~start ~stop:(Input.mark t.input) in
Token.Tag_directive { handle; prefix }, span
886
-
| _ when String.length name > 0 && name.[0] >= 'A' && name.[0] <= 'Z' ->
887
-
(* Reserved directive *)
888
-
Error.raise_span span (Reserved_directive name)
891
-
(* Unknown directive - skip to end of line *)
978
+
(* Reserved/Unknown directive - skip to end of line and ignore *)
979
+
(* Per YAML spec, reserved directives should be ignored with a warning *)
while not (Input.is_eof t.input) && not (Input.next_is_break t.input) do
ignore (Input.next t.input)
895
-
Error.raise_span span (Invalid_directive name)
983
+
let span = Span.make ~start ~stop:(Input.mark t.input) in
984
+
(* Return an empty tag directive token to indicate directive was processed but ignored *)
985
+
Token.Tag_directive { handle = ""; prefix = "" }, span
(** Fetch the next token(s) into the queue *)
let rec fetch_next_token t =
···
| Some ',' -> fetch_flow_entry t
| Some '-' when t.flow_level = 0 && check_block_entry t ->
925
-
| Some '?' when t.flow_level = 0 && check_key t ->
1015
+
| Some '?' when check_key t ->
| Some ':' when check_value t ->
···
t.allow_simple_key <- false;
let start = Input.mark t.input in
ignore (Input.next t.input);
1097
+
(* Allow adjacent values after flow collection ends *)
1098
+
if t.flow_level > 0 then
1099
+
t.adjacent_value_allowed_at <- Some (Input.position t.input);
let span = Span.make ~start ~stop:(Input.mark t.input) in
···
and fetch_block_entry t =
if t.flow_level = 0 then begin
1026
-
if not t.allow_simple_key then
1027
-
Error.raise_at (Input.mark t.input) Expected_block_entry;
1119
+
(* Block entries don't require allow_simple_key to be true, because:
1120
+
1. They're not simple keys themselves
1121
+
2. They can appear after : on the same line (e.g., ": - a")
1122
+
So we only check allow_simple_key in contexts where it's truly required.
1123
+
For now, we allow block entries in block context. *)
if roll_indent t col ~sequence:true then begin
let span = Span.point (Input.mark t.input) in
···
emit t span Token.Block_entry
1058
-
(* ? followed by whitespace in block, any in flow *)
1059
-
if t.flow_level > 0 then true
1060
-
else match Input.peek_nth t.input 1 with
1154
+
(* ? followed by whitespace or flow indicator in both block and flow *)
1155
+
match Input.peek_nth t.input 1 with
1062
-
| Some c -> Input.is_whitespace c
1158
+
Input.is_whitespace c ||
1159
+
(t.flow_level > 0 && Input.is_flow_indicator c)
if t.flow_level = 0 then begin
···
let span = Span.make ~start ~stop:(Input.mark t.input) in
1088
-
emit t span Token.Key
1185
+
emit t span Token.Key;
1186
+
t.pending_value <- true (* We've emitted a KEY, now waiting for VALUE *)
1091
-
(* : followed by whitespace in block, or flow indicator in flow *)
1092
-
if t.flow_level > 0 then true
1093
-
else match Input.peek_nth t.input 1 with
1095
-
| Some c -> Input.is_whitespace c
1189
+
(* : followed by whitespace in block, or whitespace/flow indicator in flow, or adjacent value *)
1190
+
match Input.peek_nth t.input 1 with
1193
+
Input.is_whitespace c ||
1194
+
(t.flow_level > 0 && Input.is_flow_indicator c) ||
1195
+
(* Allow adjacent values in flow context at designated positions *)
1196
+
(t.flow_level > 0 &&
1197
+
match t.adjacent_value_allowed_at with
1198
+
| Some pos -> pos.Position.line = (Input.position t.input).Position.line &&
1199
+
pos.Position.column = (Input.position t.input).Position.column
(* Check for simple key *)
···
if insert_pos >= Array.length tokens then
Queue.add key_token t.tokens;
t.token_number <- t.token_number + 1;
1220
+
t.pending_value <- true; (* We've inserted a KEY token, now waiting for VALUE *)
(* Roll indent for implicit block mapping *)
if t.flow_level = 0 then begin
let col = sk.sk_position.column in
···
t.simple_keys <- None :: (List.tl t.simple_keys)
1135
-
(* No simple key - this is a complex value *)
1241
+
(* No simple key - this is a complex value (or empty key) *)
if t.flow_level = 0 then begin
if not t.allow_simple_key then
Error.raise_at (Input.mark t.input) Expected_key;
···
if roll_indent t col ~sequence:false then begin
let span = Span.point (Input.mark t.input) in
emit t span Token.Block_mapping_start
1250
+
(* Emit KEY token for empty key case (e.g., ": value") only if we don't already have a pending KEY *)
1251
+
if not t.pending_value then begin
1252
+
let span = Span.point (Input.mark t.input) in
1253
+
emit t span Token.Key;
1254
+
t.pending_value <- true
···
1276
+
(* Skip any comment that may follow the colon and whitespace *)
1277
+
skip_whitespace_and_comment t;
let span = Span.make ~start ~stop:(Input.mark t.input) in
1165
-
emit t span Token.Value
1280
+
emit t span Token.Value;
1281
+
t.pending_value <- false (* We've emitted a VALUE, no longer pending *)
···
t.allow_simple_key <- false;
t.document_has_content <- true;
let value, span = scan_single_quoted t in
1322
+
(* Allow adjacent values after quoted scalars in flow context (for JSON compatibility) *)
1323
+
skip_to_next_token t;
1324
+
if t.flow_level > 0 then
1325
+
t.adjacent_value_allowed_at <- Some (Input.position t.input);
emit t span (Token.Scalar { style = Scalar_style.Single_quoted; value })
and fetch_double_quoted t =
···
t.allow_simple_key <- false;
t.document_has_content <- true;
let value, span = scan_double_quoted t in
1333
+
(* Allow adjacent values after quoted scalars in flow context (for JSON compatibility) *)
1334
+
skip_to_next_token t;
1335
+
if t.flow_level > 0 then
1336
+
t.adjacent_value_allowed_at <- Some (Input.position t.input);
emit t span (Token.Scalar { style = Scalar_style.Double_quoted; value })
anil.recoil.org