-
Notifications
You must be signed in to change notification settings - Fork 125
/
consoleParser.ml
101 lines (86 loc) · 2.75 KB
/
consoleParser.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
(*
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA 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 GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(* CF mli *)
type t = Buffer.t
type input = Directive of string | Code of string
let create () = Buffer.create 10000
let reset accu = Buffer.clear accu
let add accu b =
Buffer.add_string accu b;
Buffer.add_char accu '\n'
let accumulate accu str =
let s = Base.String.rtrim str in
let len = String.length s in
let predlen = pred len in
let rec aux i =
if i >= predlen then (add accu s; None)
else
if (String.unsafe_get s i) = ';'
then
if String.unsafe_get s (succ i) = ';'
then
begin
let input = Base.String.rtrim (Base.String.unsafe_sub s 0 i) in
Buffer.add_string accu input;
let input = Buffer.contents accu in
reset accu;
if String.length input > 0
then
if input.[0] = '#'
then Some (Directive input)
else Some (Code input)
else None
end
else aux (i + 2)
else aux (succ i)
in aux 0
let flush accu = accumulate accu ";;"
module Directive =
struct
type arguments = string list
type 'env action = 'env -> arguments -> 'env
type regexp = string
type argument_number = int
type 'env directive = regexp * argument_number * 'env action
type 'env handler = ('env -> string -> 'env option) list
let empty () = []
let add handler directive =
match directive with
| regexp, argument_number, action ->
let reg = Str.regexp regexp in
let filter env dir =
if Str.string_match reg dir 0
then
try
let args =
let rec aux accu i =
if i < 1 then accu else aux ((Str.matched_group i dir)::accu) (pred i)
in aux [] argument_number
in
Some (action env args)
with
| Not_found -> None
else None
in
filter :: handler
let parse handler env input =
let rec aux = function
| [] -> None
| hd::tl -> (
match hd env input with
| ( Some _ ) as result -> result
| None -> aux tl
)
in aux handler
end