diff --git a/lib/kernel/matchers/omega.ml b/lib/kernel/matchers/omega.ml index eeec516..2eb148e 100644 --- a/lib/kernel/matchers/omega.ml +++ b/lib/kernel/matchers/omega.ml @@ -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) diff --git a/lib/kernel/matchers/omega_parser_helper.ml b/lib/kernel/matchers/omega_parser_helper.ml index df5102b..41634b4 100644 --- a/lib/kernel/matchers/omega_parser_helper.ml +++ b/lib/kernel/matchers/omega_parser_helper.ml @@ -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'