mirror of
https://github.com/comby-tools/comby.git
synced 2024-09-11 13:25:36 +03:00
delete unused code
This commit is contained in:
parent
1a48b2fb3d
commit
5cf2e20d34
@ -515,290 +515,6 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) (Ext : External.
|
||||
convert ?left_delimiter ?right_delimiter p_list
|
||||
|> seq
|
||||
|
||||
let sequence_chain_unused ?left_delimiter ?right_delimiter (p_list : (production * 'a) t list) =
|
||||
if debug then Format.printf "Sequence chain p_list size: %d@." @@ List.length p_list;
|
||||
let i = ref 0 in
|
||||
List.fold_right p_list ~init:(return (Unit, acc)) ~f:(fun p acc ->
|
||||
let result =
|
||||
if debug then Format.printf "iterate fold_right %d@." !i;
|
||||
match parse_string ~consume:All p "_signal_hole" with
|
||||
| Error s ->
|
||||
if debug then Format.printf "Composing p with terminating parser, error %s@." s;
|
||||
p *> acc
|
||||
| Ok (Hole { sort; identifier; dimension; _ }, user_state) ->
|
||||
begin
|
||||
match sort with
|
||||
| Regex ->
|
||||
let identifier, pattern = String.lsplit2_exn identifier ~on:'~' in
|
||||
let identifier = if String.(identifier = "") then "_" else identifier in
|
||||
if debug then Format.printf "Regex: Id: %s Pat: %s@." identifier pattern;
|
||||
let pattern, prefix =
|
||||
if String.is_prefix pattern ~prefix:"^" then
|
||||
(* FIXME: match beginning of input too *)
|
||||
String.drop_prefix pattern 1,
|
||||
Some (
|
||||
(char '\n' *> return "")
|
||||
<|>
|
||||
(pos >>= fun p -> if p = 0 then return "" else fail "")
|
||||
)
|
||||
else
|
||||
pattern, None
|
||||
in
|
||||
let pattern, suffix =
|
||||
if String.is_suffix pattern ~suffix:"$" then
|
||||
String.drop_suffix pattern 1, Some (char '\n' *> return "" <|> end_of_input *> return "")
|
||||
else
|
||||
pattern, None
|
||||
in
|
||||
let compiled_regexp = Regexp.PCRE.make_regexp pattern in
|
||||
let regexp_parser = Regexp.PCRE.regexp compiled_regexp in
|
||||
let regexp_parser =
|
||||
match prefix, suffix with
|
||||
| Some prefix, None -> prefix *> regexp_parser
|
||||
| None, Some suffix -> regexp_parser <* suffix
|
||||
| Some prefix, Some suffix -> prefix *> regexp_parser <* suffix
|
||||
| None, None -> regexp_parser
|
||||
in
|
||||
(* the eof matters here for that one tricky test case *)
|
||||
let base_parser =
|
||||
[ regexp_parser
|
||||
; end_of_input >>= fun () -> return ""
|
||||
]
|
||||
in
|
||||
pos >>= fun offset ->
|
||||
choice base_parser >>= fun value ->
|
||||
if debug then Format.printf "Regex match @@ %d value %s@." offset value;
|
||||
acc >>= fun _ ->
|
||||
let m =
|
||||
{ offset
|
||||
; identifier
|
||||
; text = value
|
||||
}
|
||||
in
|
||||
r user_state (Match m)
|
||||
| Alphanum ->
|
||||
pos >>= fun offset ->
|
||||
many1 (generate_single_hole_parser ())
|
||||
>>= fun value ->
|
||||
(* acc must come after in order to sat. try mimic alpha to better express this. *)
|
||||
acc >>= fun _ ->
|
||||
let m =
|
||||
{ offset
|
||||
; identifier
|
||||
; text = String.concat value
|
||||
}
|
||||
in
|
||||
r user_state (Match m)
|
||||
| Non_space ->
|
||||
if debug then Format.printf "Doing non_space@.";
|
||||
let first_pos = ref (-1) in
|
||||
let set_pos v = first_pos := v in
|
||||
let get_pos () = !first_pos in
|
||||
let rest =
|
||||
(* if this is the base case (the first time we go around the
|
||||
loop backwards, when the first parser is a hole), then it
|
||||
means there's a hole at the end without anything following
|
||||
it in the template. So it should always match to
|
||||
end_of_input, not empty string. If it matches to empty
|
||||
string it chops up the matches so that f,o,o are three
|
||||
matches of foo. *)
|
||||
if !i = 0 then
|
||||
(if debug then Format.printf "hole until: match to the end of this level@.";
|
||||
end_of_input)
|
||||
else
|
||||
(if debug then Format.printf "hole until: append suffix@.";
|
||||
Omega_parser_helper.skip acc)
|
||||
in
|
||||
(
|
||||
pos >>= fun pos ->
|
||||
if get_pos () = (-1) then set_pos pos;
|
||||
let stop_at = choice [ rest; Omega_parser_helper.skip reserved_parsers ] in
|
||||
many1_till_stop any_char stop_at (* Beware of this use. *)
|
||||
)
|
||||
>>= fun value ->
|
||||
acc >>= fun _ ->
|
||||
let offset =
|
||||
match get_pos () with
|
||||
| -1 -> failwith "Did not expect unset offset"
|
||||
| offset ->
|
||||
if debug then Format.printf "Offset: %d@." offset;
|
||||
set_pos (-1);
|
||||
offset
|
||||
in
|
||||
let m =
|
||||
{ offset
|
||||
; identifier
|
||||
; text = String.of_char_list value
|
||||
}
|
||||
in
|
||||
r user_state (Match m)
|
||||
| Line ->
|
||||
pos >>= fun offset ->
|
||||
let allowed =
|
||||
many (not_followed_by (char '\n') *> any_char)
|
||||
>>| fun x -> [(String.of_char_list x)^"\n"]
|
||||
in
|
||||
allowed <* char '\n' >>= fun value ->
|
||||
acc >>= fun _ ->
|
||||
let m =
|
||||
{ offset
|
||||
; identifier
|
||||
; text = String.concat value
|
||||
}
|
||||
in
|
||||
r user_state (Match m)
|
||||
| Expression ->
|
||||
let first_pos = ref (-1) in
|
||||
let set_pos v = first_pos := v in
|
||||
let get_pos () = !first_pos in
|
||||
let _non_space : string t =
|
||||
let rest =
|
||||
if !i = 0 then end_of_input
|
||||
else Omega_parser_helper.skip acc
|
||||
in
|
||||
(
|
||||
pos >>= fun pos ->
|
||||
if get_pos () = (-1) then set_pos pos;
|
||||
let stop_at = choice [ rest; Omega_parser_helper.skip reserved_parsers ] in
|
||||
many1_till_stop any_char stop_at (* Beware of this use. *)
|
||||
) >>| String.of_char_list
|
||||
in
|
||||
let non_space =
|
||||
many1 (not_followed_by (Omega_parser_helper.skip (char ' ') <|> Omega_parser_helper.skip reserved_parsers) *> any_char) >>| String.of_char_list
|
||||
in
|
||||
let delimited =
|
||||
(* IDK why this rest works without end_of_input but it's needed for non_space. *)
|
||||
let rest = Omega_parser_helper.skip acc in
|
||||
(many1_till
|
||||
(pos >>= fun pos ->
|
||||
if debug then Format.printf "Pos is %d@." pos;
|
||||
if get_pos () = (-1) then set_pos pos;
|
||||
(match dimension with
|
||||
| Code ->
|
||||
generate_delimited_hole_parser
|
||||
?priority_left_delimiter:left_delimiter
|
||||
?priority_right_delimiter:right_delimiter
|
||||
()
|
||||
| Escapable_string_literal ->
|
||||
let right_delimiter = Option.value_exn right_delimiter in
|
||||
escapable_literal_grammar ~right_delimiter
|
||||
| Raw_string_literal ->
|
||||
let right_delimiter = Option.value_exn right_delimiter in
|
||||
escapable_literal_grammar ~right_delimiter
|
||||
| _ -> failwith "Unimplemented for comment"
|
||||
)
|
||||
)
|
||||
(pos >>= fun pos ->
|
||||
if get_pos () = (-1) then set_pos pos;
|
||||
if debug then Format.printf "Pos is %d@." pos;
|
||||
rest)
|
||||
(* it may be that the many till for the first parser
|
||||
succeeds on 'empty string', specifically in the :[1]:[2]
|
||||
case for :[1]. We won't capture the pos of :[1] in the
|
||||
first parser since it doesn't fire, so we have to
|
||||
set the pos right before the until parser below, if that
|
||||
happens. *)
|
||||
) >>| String.concat
|
||||
in
|
||||
(many1 @@ choice [non_space; delimited])
|
||||
>>= fun value ->
|
||||
acc >>= fun _ ->
|
||||
let offset =
|
||||
match get_pos () with
|
||||
| -1 -> failwith "Did not expect unset offset"
|
||||
| offset ->
|
||||
if debug then Format.printf "Offset: %d@." offset;
|
||||
set_pos (-1);
|
||||
offset
|
||||
in
|
||||
let m =
|
||||
{ offset
|
||||
; identifier
|
||||
; text = String.concat value
|
||||
}
|
||||
in
|
||||
r user_state (Match m)
|
||||
| Blank ->
|
||||
pos >>= fun offset ->
|
||||
many1 blank >>= fun value ->
|
||||
acc >>= fun _ ->
|
||||
let m =
|
||||
{ offset
|
||||
; identifier
|
||||
; text = String.of_char_list value
|
||||
}
|
||||
in
|
||||
r user_state (Match m)
|
||||
| Everything ->
|
||||
if debug then Format.printf "do hole %s@." identifier;
|
||||
(* change this so that rest is not consumed *)
|
||||
let rest =
|
||||
(* if this is the base case (the first time we go around the
|
||||
loop backwards, when the first parser is a hole), then it
|
||||
means there's a hole at the end without anything following
|
||||
it in the template. So it should always match to
|
||||
end_of_input (not empty string) *)
|
||||
if !i = 0 then
|
||||
(if debug then Format.printf "hole everything until: match to the end of this level@.";
|
||||
end_of_input)
|
||||
else
|
||||
(if debug then Format.printf "hole everything until: append suffix@.";
|
||||
Omega_parser_helper.skip acc)
|
||||
in
|
||||
let first_pos = ref (-1) in
|
||||
let set_pos v = first_pos := v in
|
||||
let get_pos () = !first_pos in
|
||||
let hole_matcher =
|
||||
(many_till
|
||||
(pos >>= fun pos ->
|
||||
if debug then Format.printf "Pos is %d@." pos;
|
||||
if get_pos () = (-1) then set_pos pos;
|
||||
(match dimension with
|
||||
| Code -> generate_everything_hole_parser ()
|
||||
| Escapable_string_literal ->
|
||||
let right_delimiter = Option.value_exn right_delimiter in
|
||||
escapable_literal_grammar ~right_delimiter
|
||||
| Raw_string_literal ->
|
||||
let right_delimiter = Option.value_exn right_delimiter in
|
||||
escapable_literal_grammar ~right_delimiter
|
||||
| _ -> failwith "Unimplemented for comment"
|
||||
)
|
||||
)
|
||||
(pos >>= fun pos ->
|
||||
if get_pos () = (-1) then set_pos pos;
|
||||
if debug then Format.printf "Pos is %d@." pos;
|
||||
rest)
|
||||
(* it may be that the many till for the first parser
|
||||
succeeds on 'empty string', specifically in the :[1]:[2]
|
||||
case for :[1]. We won't capture the pos of :[1] in the
|
||||
first parser since it doesn't fire, so we have to
|
||||
set the pos right before the until parser below, if that
|
||||
happens. *)
|
||||
) >>| String.concat
|
||||
in
|
||||
hole_matcher >>= fun text ->
|
||||
let offset =
|
||||
match get_pos () with
|
||||
| -1 -> failwith "Did not expect unset offset"
|
||||
| offset ->
|
||||
if debug then Format.printf "Offset: %d@." offset;
|
||||
set_pos (-1);
|
||||
offset
|
||||
in
|
||||
let m =
|
||||
{ offset
|
||||
; identifier
|
||||
; text
|
||||
}
|
||||
in
|
||||
if debug then Format.printf "Recording!@.";
|
||||
r user_state (Match m)
|
||||
end
|
||||
| Ok (_, _user_state) -> failwith "unreachable: _signal_hole parsed but not handled by Hole variant"
|
||||
in
|
||||
i := !i + 1;
|
||||
result)
|
||||
|
||||
let generate_pure_spaces_parser _ignored =
|
||||
spaces1 >>= fun s1 -> r acc (Template_string s1)
|
||||
|
||||
|
@ -48,31 +48,6 @@ let many1_till_stop p t =
|
||||
lift2 cons one (many_till_stop p t)
|
||||
|
||||
|
||||
module Deprecate = struct
|
||||
(* XXX can shortcircuit *)
|
||||
(* what if you hit a reserved
|
||||
sequence "{" 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
|
||||
|
||||
|
||||
let alphanum =
|
||||
satisfy (function
|
||||
| 'a' .. 'z'
|
||||
|
Loading…
Reference in New Issue
Block a user