Save

Author: emilienlemaire

src/lsp/cobol_preproc/src_lexer.mll

@@ -174,24 +174,25 @@
 let tab = '\t'
 let newline = '\r'* '\n'
 let nnl = _ # ['\r' '\n']                             (* anything but newline *)
-let sna = nnl nnl nnl nnl nnl nnl              (* 6 chars; TODO: exclude tabs *)
+let nnl' = _ # ['\t' '\r' '\n']                       (* anything but newline or tab *)
+let sna = nnl' nnl' nnl' nnl' nnl' nnl'              (* 6 chars *)
 let tabs =
   (tab |
-   nnl tab |
-   nnl nnl tab |
-   nnl nnl nnl tab |
-   nnl nnl nnl nnl tab |
-   nnl nnl nnl nnl nnl tab |
-   nnl nnl nnl nnl nnl nnl tab |
-   nnl nnl nnl nnl nnl nnl nnl tab)
+   nnl' tab |
+   nnl' nnl' tab |
+   nnl' nnl' nnl' tab |
+   nnl' nnl' nnl' nnl' tab |
+   nnl' nnl' nnl' nnl' nnl' tab |
+   nnl' nnl' nnl' nnl' nnl' nnl' tab |
+   nnl' nnl' nnl' nnl' nnl' nnl' nnl' tab)
 let spaces = ([' ' '\t']*)
 let    blank        = [' ' '\009' '\r']
-let nonblank        = nnl # blank
+let nonblank        = nnl' # blank
 let    blanks       =(blank | '\t')+
-let    blank_area_A = blank blank blank blanks | '\t'
-let nonblank_area_A =(nonblank nnl nnl nnl |
-                      blank nonblank nnl nnl |
-                      blank blank nonblank nnl |
+let    blank_area_A = blank blank blank blanks
+let nonblank_area_A =(nonblank nnl' nnl' nnl' |
+                      blank nonblank nnl' nnl' |
+                      blank blank nonblank nnl' |
                       blank blank blank nonblank)
 let nonblank = nonblank # ['\t']    (* now, also exclude tab from blank chars *)
 let separator = [ ',' ';' ]

src/lsp/cobol_preproc/src_lexing.ml

@@ -20,6 +20,27 @@ open Src_format
 
 (* --- *)
 
+let expand_tabs ?(tab_stop=8) ?(starting_col=0) src =
+  match String.index_opt src '\t' with
+  | None -> src
+  | Some _ ->
+      let buf = Buffer.create (String.length src) in
+      let col = ref starting_col in
+      let spaces = String.make tab_stop ' ' in
+      String.iter (function
+        | '\t' ->
+            let n = (tab_stop - !col mod tab_stop) in
+            Buffer.add_substring buf spaces 0 n;
+            col := !col + 1
+        | ('\n' | '\r') as c ->
+            Buffer.add_char buf c;
+            col := 0;
+        | c ->
+            Buffer.add_char buf c;
+            incr col)
+      src;
+      Buffer.contents buf
+
 let remove_blanks = Str.global_replace (Str.regexp " ") ""           (* '\t'? *)
 
 (* --- *)

src/lsp/cobol_preproc/src_lexing.mli

@@ -11,6 +11,10 @@
 (*                                                                        *)
 (**************************************************************************)
 
+val expand_tabs: ?tab_stop:int -> ?starting_col:int -> string -> string
+
+(** -- *)
+
 type 'k state
 
 val init_state: 'k Src_format.source_format -> 'k state

src/lsp/cobol_preproc/src_reader.ml

@@ -272,7 +272,7 @@ let from ?source_format (input: Src_input.t) =
   let source_format, input = start_reading input ?source_format in
   match input with
   | String { contents; filename } ->
-      from_string ~source_format ~filename contents
+      from_string ~source_format ~filename (Src_lexing.expand_tabs contents)
   | Channel { ic; filename } ->
       from_channel ~source_format ~filename ic
 
@@ -285,6 +285,7 @@ let restart make_lexing make_input ?source_format ?position
     input (Plx (s, prev_lexbuf)) =
   match position with
   | Some position when position.Lexing.pos_cnum > 0 ->
+      let start_col = position.pos_cnum - position.pos_bol in
       let lexbuf = make_lexing ?with_positions:(Some true) input in
       Lexing.set_position lexbuf position;
       Lexing.set_filename lexbuf position.Lexing.pos_fname;        (* useful? *)

test/cobol_parsing/tokens.ml

@@ -146,3 +146,69 @@ let%expect_test "token-locations-with-missing-program-id" =
       WORD[x]@<prog.cob:11-20|11-21>
       .@<prog.cob:11-21|11-22>
       EOF@<prog.cob:11-22|11-22> |}];;
+
+let%expect_test "tokens-with-tabs" =
+  Parser_testing.show_parsed_tokens ~source_format:(SF SFFixed)
+    ~parser_options:(Parser_testing.options ~verbose:true ())
+    {|
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       PROCEDURE DIVISION.
+      		STRING 	W-AGT ";"   W-RUBNUM (J) ";" 
+      		W-RENVOINOTE W-DEST-NOM  ";" 
+      		W-DEST-RUE1  ";"  W-DEST-RUE2  ";" 
+      		W-DEST-CP ";"  W-DEST-VILLE 
+      		";" W-DEST-TEL1 (1:2)  " "
+                   W-DEST-TEL1 (3:2)  " "
+                   W-DEST-TEL1 (5:2)  " "
+                   W-DEST-TEL1 (7:2)  " "
+                   W-DEST-TEL1 (9:2)
+             delimited  by  "   "  into  LARTISAN.
+|};
+    [%expect {|
+      Tks: PROCEDURE, DIVISION, .
+      Tks':
+      Tks: WORD[para-1], .
+      Tks: IF
+      Tks: WORD[X], >, DIGITS[9]
+      Tks: THEN, IF
+      Tks: WORD[X], >, DIGITS[6]
+      Tks: THEN, DISPLAY, "2"
+      Incoming: {UNDERLINE, REVERSE-VIDEO, LOWLIGHT, HIGHLIGHT, FOREGROUND-COLOR,
+                 ERASE, BLINK, BELL, BACKGROUND-COLOR}
+      Tks': "2"
+      Tks: ELSE, MOVE, DIGITS[1], TO
+      Outgoing: {UNDERLINE, REVERSE-VIDEO, LOWLIGHT, HIGHLIGHT, FOREGROUND-COLOR,
+                 ERASE, BLINK, BELL, BACKGROUND-COLOR}
+      Tks: WORD[x]
+      Tks: ELSE, MOVE, DIGITS[1], TO, WORD[x], ., EOF
+      Tks':
+      PROCEDURE@<prog.cob:1-0|1-9>
+      DIVISION@<prog.cob:1-10|1-18>
+      .@<prog.cob:1-18|1-19>
+      WORD[para-1]@<prog.cob:2-4|2-10>
+      .@<prog.cob:2-10|2-11>
+      IF@<prog.cob:3-8|3-10>
+      WORD[X]@<prog.cob:3-11|3-12>
+      >@<prog.cob:3-12|3-13>
+      DIGITS[9]@<prog.cob:3-13|3-14>
+      THEN@<prog.cob:4-8|4-12>
+      IF@<prog.cob:5-11|5-13>
+      WORD[X]@<prog.cob:5-14|5-15>
+      >@<prog.cob:5-15|5-16>
+      DIGITS[6]@<prog.cob:5-16|5-17>
+      THEN@<prog.cob:6-11|6-15>
+      DISPLAY@<prog.cob:7-14|7-21>
+      "2"@<prog.cob:7-22|7-25>
+      ELSE@<prog.cob:8-11|8-15>
+      MOVE@<prog.cob:9-14|9-18>
+      DIGITS[1]@<prog.cob:9-19|9-20>
+      TO@<prog.cob:9-21|9-23>
+      WORD[x]@<prog.cob:9-24|9-25>
+      ELSE@<prog.cob:10-8|10-12>
+      MOVE@<prog.cob:11-10|11-14>
+      DIGITS[1]@<prog.cob:11-15|11-16>
+      TO@<prog.cob:11-17|11-19>
+      WORD[x]@<prog.cob:11-20|11-21>
+      .@<prog.cob:11-21|11-22>
+      EOF@<prog.cob:11-22|11-22> |}];;