apatch/textformat.ml at master · andrewf/apatch · GitHub

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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
open Str;;

let escapeChar = '\\';;
let sigil = '%';;
let opener = '[';;
let closer = ']';;
let keepChar = 'K';;
let delChar  = 'D';;

(* the strings here are for storing characters that we know will
eventually wind up in an InsChars, but we want to collect the
whole thing before constructing it. I guess I could have just made
them `of InsChars', but whatever *)
type readerState = Inserting of string (* start state is `Inserting ""` *)
                 (* these two are for handling escape sequences *)
                 | EscapeFound of string
                 | EscapedSigilFound of string
                 (* for parsing reader forms *)
                 | ExpectingOpener of string (* still need to keep insert buffer in
                                                case we don't find opener *)
                 | ExpectingType (* next char is D or K *)
                 | ReadingN of string * (int -> Patch.segment);;

let string_of_char c = String.make 1 c;;
let digit_regex = regexp "[0123456789]$";;
let is_digit c = string_match digit_regex (string_of_char c) 0;;

(* state -> c -> (new state, new segment option *)
let advanceReader state c =
    let yield s = (Inserting "", Some s) in
    let transition st = (st, None) in
    match state with
    | Inserting s ->
        if c = escapeChar then
            transition (EscapeFound s)
        else if c = sigil then
            transition (ExpectingOpener s)
        else
            transition (Inserting (s ^ (string_of_char c)))
    | EscapeFound s ->
        (* backslash found, expecting sigil, maybe *)
        if c = sigil then
            transition (EscapedSigilFound s)
        else
            (* false alarm, dump everything matched so far to the insert seg *)
            transition (Inserting (s ^ (string_of_char escapeChar) ^ (string_of_char c)))
    | EscapedSigilFound s ->
        if c = opener then
            (* found whole escape sequence, put escaped chars in insert stream *)
            transition (Inserting (s ^ (string_of_char sigil) ^ (string_of_char opener)))
        else
            transition (Inserting (s ^ (string_of_char escapeChar)
                                ^ (string_of_char sigil)
                                ^ (string_of_char c)))
    | ExpectingOpener s ->
        (* sigil found, maybe we'll see opening bracket *)
        if c = opener then
            (ExpectingType, if not (s="") then Some (Patch.InsChars s) else None)
        else
            (* false alarm, dump matched char *)
            transition (Inserting (s ^ (string_of_char sigil)))
    | ExpectingType ->
        if c=keepChar then
            transition (ReadingN ("", (fun n -> Patch.KeepChars n)))
        else if c = delChar then
            transition (ReadingN ("", (fun n -> Patch.DelChars n)))
        else
            failwith "invalid reader form"
    | ReadingN (s, ctor) ->
        if is_digit c then
            transition (ReadingN ((s^(string_of_char c)), ctor))
        else if c = closer then
            yield (ctor (int_of_string s))
        else
            failwith "non-digit char in reader form"
;;

let finishReading state =
    match state with
    | Inserting "" -> None
    | Inserting s -> Some (Patch.InsChars s)
    | EscapeFound s -> Some (Patch.InsChars (s ^ (string_of_char escapeChar)))
    | EscapedSigilFound s -> Some (Patch.InsChars (s ^ (string_of_char escapeChar)
                                                     ^ (string_of_char sigil)))
    | ExpectingOpener s -> Some (Patch.InsChars (s ^ (string_of_char sigil)))
    | _ -> failwith "File ended inside read form"
;;

let rec reverse l =
    let rec helper rest list_before =
        match rest with
        | [] -> []
        | [x] -> x :: list_before
        | x :: xs -> (helper xs (x::list_before))
    in helper l []
;;

class patchBuilder = object(self)
    val mutable state = Inserting ""
    val mutable result = ([] : Patch.segment list)
    method maybeAddSeg seg =
        match seg with
        | Some s -> (result <- s::result)
        | None -> ()
    method addChar c =
        (* this algo builds result in reverse order *)
        let newstate, yielded = advanceReader state c in begin
            state <- newstate;
            self#maybeAddSeg yielded
        end
    method finish =
        self#maybeAddSeg (finishReading state)
    method getResult = reverse result (* actually, unreverse *)
end

let readString str =
    let builder = new patchBuilder in begin
        String.iter (fun c -> builder#addChar c) str;
        builder#finish;
        builder#getResult
    end
;;

let readFile chan = begin
    let builder = new patchBuilder in (try
        while true do
            builder#addChar (input_char chan)
        done
    with End_of_file -> (builder#finish));
    builder#getResult
end ;;

let escape s =
    let mustEscape = (string_of_char sigil) ^ (string_of_char opener) in
    (* use of regexp_string avoids syntax difficulties in matching '[' *)
    let r = regexp_string mustEscape in
    global_replace r ((string_of_char escapeChar) ^ mustEscape) s;;

let string_of_segment seg =
    match seg with
    | Patch.InsChars s -> escape s
    | Patch.KeepChars n ->
        ((string_of_char sigil) ^
         (string_of_char opener) ^
         (string_of_char keepChar) ^
         (string_of_int n) ^
         (string_of_char closer))
    | Patch.DelChars n ->
        ((string_of_char sigil) ^
         (string_of_char opener) ^
         (string_of_char delChar) ^
         (string_of_int n) ^
         (string_of_char closer))
;;

let writeString patch =
    (List.fold_left
        (fun prev seg -> (prev ^ (string_of_segment seg)))
        ""
        patch)