1095

pending completion

Build # 1095

Build Type

Pull #202

travis-ci-com

Committed by

web-flow

Commit Message

<a href="https://github.com/comby-tools/comby/commit/<a class=hub.com/comby-tools/comby/commit/<a class="double-link" href="https://git"><a class=hub.com/comby-tools/comby/commit/<a class="double-link" href="https://git"><a class=hub.com/comby-tools/comby/commit/<a class="double-link" href="https://git"><a class=hub.com/comby-tools/comby/commit/<a class="double-link" href="https://git"><a class=hub.com/comby-tools/comby/commit/adbd1a807c3d857bc465b6e7e3b32c7b4f61ab43">adbd1a807">&lt;a href=&quot;https://github.com/comby-tools/comby/commit/</a><a class="double-link" href="https://github.com/comby-tools/comby/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/comby-tools/comby/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/comby-tools/comby/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/comby-tools/comby/commit/adbd1a807c3d857bc465b6e7e3b32c7b4f61ab43">adbd1a807</a><a href="https://github.com/comby-tools/comby/commit/adbd1a807c3d857bc465b6e7e3b32c7b4f61ab43">&lt;a href=&quot;https://github.com/comby-tools/comby/commit/adbd1a807c3d857bc465b6e7e3b32c7b4f61ab43&quot;&gt;&amp;quot;&amp;gt;&amp;amp;lt;a href=&amp;amp;quot;https://github.com/comby-tools/comby/commit/&amp;lt;/a&amp;gt;&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://github.com/comby-tools/comby/commit/&amp;amp;lt;a class=&amp;amp;quot;double-link&amp;amp;quot; href=&amp;amp;quot;https://git&amp;quot;&amp;gt;&amp;amp;lt;a class=&amp;lt;/a&amp;gt;hub.com/comby-tools/comby/commit/adbd1a807c3d857bc465b6e7e3b32c7b4f61ab43&amp;quot;&amp;gt;adbd1a807&amp;lt;/a&amp;gt;&amp;lt;a href=&amp;quot;https://github.com/comby-tools/comby/commit/adbd1a807c3d857bc465b6e7e3b32c7b4f61ab43&amp;quot;&amp;gt;&amp;amp;lt;a href=&amp;amp;quot;https://github.com/comby-tools/comby/commit/adbd1a807c3d857bc465b6e7e3b32c7b&amp;lt;/a&amp;gt;4f61a</a>b43&quot;&gt;&amp;quot;&amp;gt;Merge &amp;lt;/a&amp;gt;&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://github.com/comby-tools/comby/commit/&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://github.com/comby-tools/comby/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://github.com/comby-tools/comby/commit/bd63e3cae&quot;&gt;bd63e3c... (continued)

Pull Request Pull Request #202: Simplify 'everything' matching at the toplevel to be line based

Run Details

28 of 28 new or added lines in 3 files covered. (100.0%)

1620 of 2198 relevant lines covered (73.7%)

6212.43 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

77.05

/lib/matchers/parser.ml

open Core

open Angstrom

let (|>>) p f =
  p >>= fun x -> return (f x)

let between left right p =
  left *> p <* right

let zero =
  fail ""

let cons x xs = x :: xs

let debug = true

let dont_use_any_char_except_parser p =
  if debug then Format.printf "Entered@.";
  let stop = ref false in
  let set_stop v = stop := v in
  let get_stop () = !stop in
  let c =
    choice
      [ (p >>= fun reserved -> pos >>= fun po -> (if debug then Format.printf "1. stop @@ %s @@ %d@." reserved po; return (set_stop true)) >>= fun _ -> fail "stop")
      ; (return () >>= fun _ -> Format.printf "X@."; if get_stop () then (if debug then Format.printf "2. stop@."; fail "stop") else any_char)
      ]
  in
  c >>= fun c' -> if debug then Format.printf "Parsed: %c@." c'; if debug then Format.printf "Exit@."; return c'

let dont_use_is_not p =
  dont_use_any_char_except_parser p

let many_till_stop p t =
  let stop = ref false in
  let set_stop v = stop := v in
  let get_stop () = !stop in
  fix (fun m ->
      choice
        [ (t >>= fun _ -> (return (set_stop true)) >>= fun _ -> fail "stop")
        ; (return () >>= fun _ -> if get_stop () then return [] else lift2 cons p m)
        ])

let many1_till_stop p t =
  let stop = ref false in
  let set_stop v = stop := v in
  let get_stop () = !stop in
  (* one needs to fail if p isn't successful so that it doesn't consume and advance one char *)
  let one =
    choice
      [ (t >>= fun _ -> (return (set_stop true)) >>= fun _ -> fail "stop")
      ; (return () >>= fun _ -> if get_stop () then fail "stop" else p)
      ]
  in
  lift2 cons one (many_till_stop p t)


(* use many1_till_stop instead of "many1 (any_allowed_except_parser allowed until" *)
(*
let any_allowed_except_parser allowed p =
  let rewind = ref false in
  let set_rewind v = rewind := v in
  let get_rewind () = !rewind in
  choice
    [ (p >>= fun _ -> (return (set_rewind true)) >>= fun _ -> fail "bad")
    ; (return () >>= fun _ -> if get_rewind () then fail "rewind" else allowed)
      (* TODO this needs some kind of EOF condition to work for both template and match parsing *)
    ]
*)

let alphanum =
  satisfy (function
      | 'a' .. 'z'
      | 'A' .. 'Z'
      | '0' .. '9' -> true
      | _ -> false)

let is_whitespace = function
  | ' ' | '\t' | '\r' | '\n' -> true
  | _ -> false

let is_blank = function
  | ' ' | '\t' -> true
  | _ -> false

let blank =
  choice
    [ char ' '
    ; char '\t'
    ]

let many_till p t =
  fix (fun m -> (t *> return []) <|> (lift2 cons p m))

let many1_till p t =
  lift2 cons p (many_till p t)

let skip_unit p =
  p |>> ignore

module Deprecate = struct
  (* XXX can shortcircuit *)
  (* what if you hit a reserved
     seqence "{" and then attempt
     ":[[" and then say "end of
     input" and then move ahead any_char. not good.
     going from longest to shortest works though *)
  let any_char_except ~reserved =
    List.fold reserved
      ~init:(return `OK)
      ~f:(fun acc reserved_sequence ->
          option `End_of_input
            (peek_string (String.length reserved_sequence)
             >>= fun s ->
             if String.equal s reserved_sequence then
               return `Reserved_sequence
             else
               acc))
    >>= function
    | `OK -> any_char
    | `End_of_input -> any_char
    | `Reserved_sequence -> fail "reserved sequence hit"
end

(** must have at least one, otherwise spins on the empty string. for some reason
    many1 spaces is not equivalent (spins on empty space?). *)
let spaces1 =
  satisfy is_whitespace >>= fun c ->
  (* XXX use skip_while once everything works.
     we don't need the string *)
  take_while is_whitespace >>= fun s ->
  return (Format.sprintf "%c%s" c s)

let blank1 =
  satisfy is_blank >>= fun c ->
  (* XXX use skip_while once everything works.
     we don't need the string *)
  take_while is_blank >>= fun s ->
  return (Format.sprintf "%c%s" c s)


let spaces =
  take_while is_whitespace >>= fun s ->
  return s

let identifier_parser () =
  many (alphanum <|> char '_')
  |>> String.of_char_list

let many1_till p t =
  let cons x xs = x::xs in
  lift2 cons p (many_till p t)

1	open Core
2
3	open Angstrom
4
5	let (\|>>) p f =
6	p >>= fun x -> return (f x)	10,387✔
7
8	let between left right p =
9	left > p < right	28,503✔
10
11	let zero =
12	fail ""	79✔
13
14	let cons x xs = x :: xs	51,813✔
15
16	let debug = true
17
18	let dont_use_any_char_except_parser p =
19	if debug then Format.printf "Entered@.";	×
20	let stop = ref false in	×
21	let set_stop v = stop := v in	×
22	let get_stop () = !stop in	×
23	let c =
24	choice
25	[ (p >>= fun reserved -> pos >>= fun po -> (if debug then Format.printf "1. stop @@ %s @@ %d@." reserved po; return (set_stop true)) >>= fun _ -> fail "stop")	×
26	; (return () >>= fun _ -> Format.printf "X@."; if get_stop () then (if debug then Format.printf "2. stop@."; fail "stop") else any_char)	×
27	]
28	in
29	c >>= fun c' -> if debug then Format.printf "Parsed: %c@." c'; if debug then Format.printf "Exit@."; return c'	×
30
31	let dont_use_is_not p =
32	dont_use_any_char_except_parser p	×
33
34	let many_till_stop p t =
35	let stop = ref false in	9,330✔
36	let set_stop v = stop := v in	5,618✔
37	let get_stop () = !stop in	31,987✔
38	fix (fun m ->
39	choice	5,618✔
40	[ (t >>= fun _ -> (return (set_stop true)) >>= fun _ -> fail "stop")	5,618✔
41	; (return () >>= fun _ -> if get_stop () then return [] else lift2 cons p m)	5,618✔
42	])
43
44	let many1_till_stop p t =
45	let stop = ref false in	9,330✔
46	let set_stop v = stop := v in	3,712✔
47	let get_stop () = !stop in	9,330✔
48	(* one needs to fail if p isn't successful so that it doesn't consume and advance one char *)
49	let one =
50	choice
51	[ (t >>= fun _ -> (return (set_stop true)) >>= fun _ -> fail "stop")	3,712✔
52	; (return () >>= fun _ -> if get_stop () then fail "stop" else p)	3,712✔
53	]
54	in
55	lift2 cons one (many_till_stop p t)	9,330✔
56
57
58	(* use many1_till_stop instead of "many1 (any_allowed_except_parser allowed until" *)
59	(*
60	let any_allowed_except_parser allowed p =
61	let rewind = ref false in
62	let set_rewind v = rewind := v in
63	let get_rewind () = !rewind in
64	choice
65	[ (p >>= fun _ -> (return (set_rewind true)) >>= fun _ -> fail "bad")
66	; (return () >>= fun _ -> if get_rewind () then fail "rewind" else allowed)
67	(* TODO this needs some kind of EOF condition to work for both template and match parsing *)
68	]
69	*)
70
71	let alphanum =
72	satisfy (function	79✔
73	\| 'a' .. 'z'	459✔
74	\| 'A' .. 'Z'	1✔
75	\| '0' .. '9' -> true	201✔
76	\| _ -> false)	408✔
77
78	let is_whitespace = function
79	\| ' ' \| '\t' \| '\r' \| '\n' -> true	×
80	\| _ -> false	12,779✔
81
82	let is_blank = function
83	\| ' ' \| '\t' -> true	×
84	\| _ -> false	9,343✔
85
86	let blank =
87	choice	79✔
88	[ char ' '	79✔
89	; char '\t'	79✔
90	]
91
92	let many_till p t =
93	fix (fun m -> (t *> return []) <\|> (lift2 cons p m))	390✔
94
95	let many1_till p t =
96	lift2 cons p (many_till p t)	×
97
98	let skip_unit p =
99	p \|>> ignore	9,940✔
100
101	module Deprecate = struct
102	(* XXX can shortcircuit *)
103	(* what if you hit a reserved
104	seqence "{" and then attempt
105	":[[" and then say "end of
106	input" and then move ahead any_char. not good.
107	going from longest to shortest works though *)
108	let any_char_except ~reserved =
109	List.fold reserved	10,256✔
110	~init:(return `OK)	10,256✔
111	~f:(fun acc reserved_sequence ->
112	option `End_of_input	95,764✔
113	(peek_string (String.length reserved_sequence)	95,764✔
114	>>= fun s ->	95,764✔
115	if String.equal s reserved_sequence then	105,241✔
116	return `Reserved_sequence	504✔
117	else
118	acc))	104,737✔
119	>>= function
120	\| `OK -> any_char	10,571✔
121	\| `End_of_input -> any_char	487✔
122	\| `Reserved_sequence -> fail "reserved sequence hit"	504✔
123	end
124
125	(** must have at least one, otherwise spins on the empty string. for some reason
126	many1 spaces is not equivalent (spins on empty space?). *)
127	let spaces1 =
128	satisfy is_whitespace >>= fun c ->	79✔
129	(* XXX use skip_while once everything works.
130	we don't need the string *)
131	take_while is_whitespace >>= fun s ->	1,697✔
132	return (Format.sprintf "%c%s" c s)	1,697✔
133
134	let blank1 =
135	satisfy is_blank >>= fun c ->	79✔
136	(* XXX use skip_while once everything works.
137	we don't need the string *)
138	take_while is_blank >>= fun s ->	×
139	return (Format.sprintf "%c%s" c s)	×
140
141
142	let spaces =
143	take_while is_whitespace >>= fun s ->	79✔
144	return s	×
145
146	let identifier_parser () =
147	many (alphanum <\|> char '_')	447✔
148	\|>> String.of_char_list
149
150	let many1_till p t =
151	let cons x xs = x::xs in	2✔
152	lift2 cons p (many_till p t)	2✔

comby-tools / comby / 1095

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous