comby-tools/comby
1
1
Fork 0
mirror of https://github.com/comby-tools/comby.git synced 2024-08-16 08:40:55 +03:00
Code Issues Packages Projects Releases Wiki Activity

delete unused code

Browse Source
This commit is contained in:
Rijnard van Tonder 2022-06-17 16:17:19 -07:00
parent 1a48b2fb3d
commit 5cf2e20d34
2 changed files with 0 additions and 309 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

284
lib/kernel/matchers/omega.ml
View File

@ -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)

25
lib/kernel/matchers/omega_parser_helper.ml
View File

@ -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'