Source file string_printer.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
open Common

module Buffer:
sig
    type t
    val init: int -> t
    val char: char -> t -> unit
    val fill: int -> char -> t -> unit
    val substring: string -> int -> int -> t -> unit
    val to_string: t -> string
end =
struct
    type t = {
        mutable bytes: Bytes.t;
        mutable count: int
      }

    let capacity (b:t): int =
        Bytes.length b.bytes

    let init (n:int): t =
        {bytes = Bytes.make n ' ';
         count = 0}

    let to_string (b:t): string =
        Bytes.sub_string b.bytes 0 b.count

    let make_room (n:int) (b:t): unit =
        if capacity b < b.count + n then
            (let new_cap =
                max (b.count + n) (2 * Bytes.length b.bytes)
             in
             let bytes = Bytes.make new_cap ' ' in
             Bytes.blit b.bytes 0 bytes 0 b.count;
             b.bytes <- bytes)
        else
            ()

    let char (c:char) (b:t): unit =
        make_room 1 b;
        Bytes.set b.bytes b.count c;
        b.count <- b.count + 1

    let fill (n:int) (c:char) (b:t): unit =
        assert (0 <= n);
        make_room n b;
        for i = 0 to n - 1 do
            Bytes.set b.bytes (b.count + i) c
        done;
        b.count <- b.count + n

    let substring (s:string) (start:int) (len:int) (b:t): unit =
        assert (0 <= start);
        assert (start + len <= String.length s);
        make_room len b;
        for i = 0 to len - 1 do
            Bytes.set b.bytes (b.count + i) s.[start + i]
        done;
        b.count <- b.count + len
end







type loop_state =
    | Done of Buffer.t
    | More of Buffer.t * (Buffer.t -> loop_state)



let loop: loop_state -> string =
    let rec do_loop i = function
    | Done buffer ->
        Buffer.to_string buffer
    | More (buffer, f) ->
        do_loop (i + 1) (f buffer)
    in
    do_loop 0




type t = Buffer.t -> (Buffer.t -> loop_state) -> loop_state




let empty: t =
    fun buffer k -> k buffer


let (<+>) (a: t) (b: t): t =
    fun buffer k ->
        a buffer (fun buffer ->
                    More (buffer,
                          (fun _ -> b buffer k)))



let char (c: char): t =
    fun buffer k ->
        Buffer.char c buffer;
        k buffer


let fill (n: int) (c: char): t =
    fun buffer k ->
        Buffer.fill n c buffer;
        k buffer


let substring (str: string) (start: int) (len: int): t =
    fun buffer k ->
        Buffer.substring str start len buffer;
        k buffer


let string (str: string): t =
    substring str 0 (String.length str)


let run (p: t): string =
    loop
        (p (Buffer.init 200) (fun buffer -> Done buffer))







let%test _ =
  run (string "hello " <+> string "world" <+> char '!')
  = "hello world!"