Source file nstream.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
(**************************************************************************)
(*                                                                        *)
(*  Copyright 2011 Jun Furuse                                             *)
(*  Copyright 2012-2013 OCamlPro                                          *)
(*                                                                        *)
(*  All rights reserved.This file is distributed under the terms of the   *)
(*  GNU Lesser General Public License version 2.1 with linking            *)
(*  exception.                                                            *)
(*                                                                        *)
(*  TypeRex is distributed in the hope that it will be useful,            *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  Lesser GNU General Public License for more details.                   *)
(*                                                                        *)
(**************************************************************************)

open Pos
open Approx_lexer

type token = {
  region  : Region.t;
  token   : Approx_lexer.token;
  newlines: int;
  between : string Lazy.t;
  substr  : string Lazy.t;
  offset  : int;
}

type cons =
  | Cons of token * t
  | Null

and t = cons lazy_t

let of_string ?(start_pos=Position.zero) ?(start_offset=0) string =
  let lexbuf = {
    Lexing.
    refill_buff = (fun lexbuf -> lexbuf.Lexing.lex_eof_reached <- true);
    lex_buffer = Bytes.of_string string;
    lex_buffer_len = String.length string;
    lex_abs_pos = start_offset;
    lex_start_pos = start_offset;
    lex_curr_pos = start_offset;
    lex_last_pos = start_offset;
    lex_last_action = 0;
    lex_mem = [||];
    lex_eof_reached = true;
    lex_start_p = start_pos;
    lex_curr_p = start_pos;
  }
  in
  Approx_lexer.init ();
  let rec loop last =
    let open Lexing in
    match Approx_lexer.token_with_comments lexbuf with
    | EOL
    | SPACES -> loop last
    | token ->
    let pos_last = Region.snd last
    and pos_start = lexbuf.lex_start_p
    and pos_end = lexbuf.lex_curr_p
    in
    let region = Region.create pos_start pos_end in
    let offset = Region.start_column region - Region.start_column last
    in
    let spaces = pos_start.pos_cnum - pos_last.pos_cnum in
    let len = pos_end.pos_cnum - pos_start.pos_cnum in
    let newlines = pos_start.pos_lnum - pos_last.pos_lnum in
    let between = lazy (String.sub string pos_last.pos_cnum spaces) in
    let substr = lazy (String.sub string pos_start.pos_cnum len) in
    Cons ({ region; token; newlines; between; substr; offset },
      lazy (match token with
        | EOF -> Null
        | _ -> loop region)
    )
  in
  let init_region =
    let pos_above =
      {start_pos with Lexing.pos_lnum = start_pos.Lexing.pos_lnum - 1}
    in
    Region.create pos_above pos_above
  in
  lazy (loop init_region)

let of_channel ?(start_pos=Position.zero) ic =
  (* add some caching to the reader function, so that
     we can get back the original strings *)
  let buf = Buffer.create 511 in
  let reader str count =
    let n = input ic str 0 count in
    Buffer.add_substring buf (Bytes.to_string str) 0 n;
    n
  in
  let lexbuf = Lexing.from_function reader in
  let lexbuf = { lexbuf with Lexing.lex_start_p = start_pos;
                             Lexing.lex_curr_p = start_pos; }
  in
  Approx_lexer.init ();
  let rec loop last =
    let open Lexing in
    match Approx_lexer.token_with_comments lexbuf with
    | EOL
    | SPACES -> loop last
    | token ->
    let pos_last = Region.snd last
    and pos_start = lexbuf.lex_start_p
    and pos_end = lexbuf.lex_curr_p
    in
    let spaces = pos_start.pos_cnum - pos_last.pos_cnum in
    let len = pos_end.pos_cnum - pos_start.pos_cnum in
    let newlines = pos_start.pos_lnum - pos_last.pos_lnum in
    let between = let s = Buffer.sub buf 0 spaces in lazy s in
    let substr = let s = Buffer.sub buf spaces len in lazy s
    in
    let total = pos_end.pos_cnum - pos_last.pos_cnum in
    let more = Buffer.sub buf total (Buffer.length buf - total) in
    Buffer.clear buf;
    Buffer.add_string buf more;
    let region = Region.create pos_start pos_end in
    let offset = Region.start_column region - Region.start_column last in
    Cons ({ region; token; newlines; between; substr; offset },
      lazy (match token with
        | EOF -> Null
        | _ -> loop region)
    )
  in
  let init_region =
    let pos_above =
      {start_pos with Lexing.pos_lnum = start_pos.Lexing.pos_lnum - 1}
    in
    Region.create pos_above pos_above
  in
  lazy (loop init_region)

let next = function
  | lazy Null -> None
  | lazy (Cons (car, cdr)) -> Some (car, cdr)