mirror of
https://github.com/comby-tools/comby.git
synced 2024-09-11 13:25:36 +03:00
Factor out shared rewrite pipeline for CLI and server
This commit is contained in:
parent
6d1286dddc
commit
c1fc7f9154
5
lib/dune
5
lib/dune
@ -7,9 +7,10 @@
|
||||
core
|
||||
mparser
|
||||
mparser.pcre
|
||||
comby.language
|
||||
comby.match
|
||||
comby.matchers
|
||||
comby.pipeline
|
||||
comby.replacement
|
||||
comby.rewriter
|
||||
comby.match
|
||||
comby.language
|
||||
comby.statistics))
|
||||
|
@ -10,6 +10,8 @@ open Rewriter
|
||||
open Ast
|
||||
open Parser
|
||||
|
||||
type t = Ast.t
|
||||
|
||||
type result = bool * environment option
|
||||
|
||||
let sat = fst
|
||||
|
@ -5,6 +5,8 @@ open Match
|
||||
|
||||
open Ast
|
||||
|
||||
type t = Ast.t
|
||||
|
||||
type result = bool * environment option
|
||||
|
||||
val sat : result -> bool
|
||||
|
@ -318,10 +318,9 @@ module Make (Syntax : Syntax.S) (Info : Info.S) = struct
|
||||
let environment =
|
||||
if Environment.exists environment identifier then
|
||||
let fresh_hole_id =
|
||||
Format.sprintf "equal_%s_%s" identifier Uuid_unix.(Fn.compose Uuid.to_string create ())
|
||||
Format.sprintf "equal~%s_%s" identifier Uuid_unix.(Fn.compose Uuid.to_string create ())
|
||||
in
|
||||
(
|
||||
Environment.add ~range environment fresh_hole_id (String.concat matched))
|
||||
Environment.add ~range environment fresh_hole_id (String.concat matched)
|
||||
else
|
||||
Environment.add ~range environment identifier (String.concat matched)
|
||||
in
|
||||
|
5
lib/pipeline/dune
Normal file
5
lib/pipeline/dune
Normal file
@ -0,0 +1,5 @@
|
||||
(library
|
||||
(name pipeline)
|
||||
(public_name comby.pipeline)
|
||||
(preprocess (pps ppx_deriving.show ppx_sexp_conv ppx_sexp_message ppx_deriving_yojson bisect_ppx -conditional -no-comment-parsing))
|
||||
(libraries comby.parsers comby.match comby.language ppxlib core core.uuid mparser mparser.pcre yojson ppx_deriving_yojson))
|
32
lib/pipeline/pipeline.ml
Normal file
32
lib/pipeline/pipeline.ml
Normal file
@ -0,0 +1,32 @@
|
||||
open Core
|
||||
|
||||
open Match
|
||||
open Language
|
||||
|
||||
let infer_equality_constraints environment =
|
||||
let vars = Environment.vars environment in
|
||||
List.fold vars ~init:[] ~f:(fun acc var ->
|
||||
if String.is_prefix var ~prefix:"equal~" then
|
||||
match String.split var ~on:'~' with
|
||||
| _equal :: target :: _uuid ->
|
||||
let expression = Language.Ast.Equal (Variable var, Variable target) in
|
||||
expression::acc
|
||||
| _ -> acc
|
||||
else
|
||||
acc)
|
||||
|
||||
let apply_rule ?(newline_separated = false) matcher rule matches =
|
||||
let open Option in
|
||||
List.filter_map matches ~f:(fun ({ environment; _ } as matched) ->
|
||||
let rule = rule @ infer_equality_constraints environment in
|
||||
let sat, env = Rule.apply ~newline_separated ~matcher rule environment in
|
||||
(if sat then env else None)
|
||||
>>| fun environment -> { matched with environment })
|
||||
|
||||
let run
|
||||
((module Matcher : Matchers.Matcher) as matcher)
|
||||
?newline_separated ?rule configuration template source =
|
||||
let matches = Matcher.all ~configuration ~template ~source in
|
||||
match rule with
|
||||
| Some rule -> apply_rule ?newline_separated matcher rule matches
|
||||
| None -> matches
|
@ -78,6 +78,14 @@ let parse_template_directories paths =
|
||||
None
|
||||
| Some match_template ->
|
||||
let rule = read_optional (path ^/ "rule") in
|
||||
let rule =
|
||||
match Option.map rule ~f:Rule.create with
|
||||
| None -> None
|
||||
| Some Ok rule -> Some rule
|
||||
| Some Error error ->
|
||||
Format.eprintf "Rule parse error: %s@." (Error.to_string_hum error);
|
||||
exit 1
|
||||
in
|
||||
let rewrite_template = read_optional (path ^/ "rewrite") in
|
||||
Specification.create ~match_template ?rule ?rewrite_template ()
|
||||
|> Option.some
|
||||
@ -466,6 +474,7 @@ let create
|
||||
let open Or_error in
|
||||
validate_errors configuration >>= fun () ->
|
||||
emit_warnings configuration >>= fun () ->
|
||||
let rule = Rule.create rule |> Or_error.ok_exn in
|
||||
let specifications =
|
||||
match specification_directories, anonymous_arguments with
|
||||
| None, Some { match_template; rewrite_template; _ } ->
|
||||
|
4
src/dune
4
src/dune
@ -5,13 +5,13 @@
|
||||
(names main))
|
||||
|
||||
(executables
|
||||
(libraries core opium comby ppx_deriving_yojson ppx_deriving_yojson.runtime hack_parallel)
|
||||
(libraries comby core opium ppx_deriving_yojson ppx_deriving_yojson.runtime hack_parallel)
|
||||
(preprocess (pps ppx_deriving_yojson ppx_let ppx_deriving.show))
|
||||
(modules server)
|
||||
(names server))
|
||||
|
||||
(executables
|
||||
(libraries core opium comby ppx_deriving_yojson ppx_deriving_yojson.runtime hack_parallel)
|
||||
(libraries comby core opium ppx_deriving_yojson ppx_deriving_yojson.runtime hack_parallel)
|
||||
(preprocess (pps ppx_deriving_yojson ppx_let ppx_deriving.show))
|
||||
(modules benchmark)
|
||||
(names benchmark))
|
||||
|
64
src/main.ml
64
src/main.ml
@ -6,8 +6,6 @@ open Hack_parallel
|
||||
open Command_configuration
|
||||
open Command_input
|
||||
open Matchers
|
||||
open Match
|
||||
open Language
|
||||
open Rewriter
|
||||
open Statistics
|
||||
|
||||
@ -28,36 +26,6 @@ let debug =
|
||||
|
||||
let verbose_out_file = "/tmp/comby.out"
|
||||
|
||||
let get_matches (module Matcher : Matchers.Matcher) configuration match_template rule source =
|
||||
let rule = Rule.create rule |> Or_error.ok_exn in
|
||||
Matcher.all ~configuration ~template:match_template ~source
|
||||
|> List.filter ~f:(fun { environment; _ } -> Rule.(sat @@ apply rule ~matcher:(module Matcher) environment))
|
||||
|
||||
let apply_rewrite_rule newline_separated matcher rewrite_rule matches =
|
||||
let open Option in
|
||||
match rewrite_rule with
|
||||
| "" -> matches
|
||||
| rewrite_rule ->
|
||||
match Rule.create rewrite_rule with
|
||||
| Ok rule ->
|
||||
List.filter_map matches ~f:(fun ({ environment; _ } as match_) ->
|
||||
let inferred_equality_constraints =
|
||||
let vars = Environment.vars environment in
|
||||
List.fold vars ~init:[] ~f:(fun acc var ->
|
||||
if String.is_prefix var ~prefix:"equal_" then
|
||||
match String.split var ~on:'_' with
|
||||
| _equal :: target :: _uuid ->
|
||||
let expression = Language.Ast.Equal (Variable var, Variable target) in
|
||||
expression::acc
|
||||
| _ -> assert false
|
||||
else
|
||||
acc)
|
||||
in
|
||||
let sat, env = Rule.apply (rule @ inferred_equality_constraints) ~newline_separated ~matcher environment in
|
||||
(if sat then env else None)
|
||||
>>| fun environment -> { match_ with environment })
|
||||
| Error _ -> []
|
||||
|
||||
let process_single_source
|
||||
((module Matcher : Matchers.Matcher) as matcher)
|
||||
newline_separate_rule_rewrites
|
||||
@ -83,27 +51,7 @@ let process_single_source
|
||||
} ->
|
||||
let matches =
|
||||
try
|
||||
let f () =
|
||||
let get_matches (module Matcher : Matchers.Matcher) configuration match_template rule source =
|
||||
let rule = Rule.create rule |> Or_error.ok_exn in
|
||||
Matcher.all ~configuration ~template:match_template ~source
|
||||
|> List.filter ~f:(fun { environment; _ } ->
|
||||
let inferred_equality_constraints =
|
||||
let vars = Environment.vars environment in
|
||||
List.fold vars ~init:[] ~f:(fun acc var ->
|
||||
if String.is_prefix var ~prefix:"equal_" then
|
||||
match String.split var ~on:'_' with
|
||||
| _equal :: target :: _uuid ->
|
||||
let expression = Language.Ast.Equal (Variable var, Variable target) in
|
||||
expression::acc
|
||||
| _ -> assert false
|
||||
else
|
||||
acc)
|
||||
in
|
||||
Rule.(sat @@ apply (rule @ inferred_equality_constraints) ~matcher:(module Matcher) environment))
|
||||
in
|
||||
get_matches matcher configuration match_template rule input_text
|
||||
in
|
||||
let f () = Pipeline.run ?rule matcher configuration match_template input_text in
|
||||
Statistics.Time.time_out ~after:match_timeout f ();
|
||||
with Statistics.Time.Time_out ->
|
||||
Format.eprintf "Timeout for input: %s!@." (show_input_kind source);
|
||||
@ -118,11 +66,9 @@ let process_single_source
|
||||
let result =
|
||||
try
|
||||
let f () =
|
||||
Matcher.all ~configuration ~template:match_template ~source:input_text
|
||||
|> fun matches ->
|
||||
(* TODO(RVT): merge match and rewrite rule application. *)
|
||||
apply_rewrite_rule newline_separate_rule_rewrites matcher rule matches
|
||||
|> fun matches ->
|
||||
let matches =
|
||||
Pipeline.run ?rule matcher ~newline_separated:newline_separate_rule_rewrites configuration match_template input_text
|
||||
in
|
||||
if matches = [] then
|
||||
(* If there are no matches, return the original source (for editor support). *)
|
||||
Some (Some (Replacement.{ rewritten_source = input_text; in_place_substitutions = [] }), [])
|
||||
@ -130,7 +76,7 @@ let process_single_source
|
||||
Some (Rewrite.all ~source:input_text ~rewrite_template matches, matches)
|
||||
in
|
||||
Statistics.Time.time_out ~after:match_timeout f ();
|
||||
with Statistics__Time.Time_out ->
|
||||
with Statistics.Time.Time_out ->
|
||||
Format.eprintf "Timeout for input: %s!@." (show_input_kind source);
|
||||
Out_channel.with_file ~append:true verbose_out_file ~f:(fun out_channel ->
|
||||
Out_channel.output_lines out_channel [Format.sprintf "TIMEOUT: FOR %s@." (show_input_kind source) ]);
|
||||
|
@ -52,40 +52,10 @@ type json_rewrite_result =
|
||||
}
|
||||
[@@deriving yojson]
|
||||
|
||||
let get_matches (module Matcher : Matchers.Matcher) source match_template =
|
||||
let configuration = Configuration.create ~match_kind:Fuzzy () in
|
||||
Matcher.all ~configuration ~template:match_template ~source
|
||||
|
||||
let matches_to_json source id matches =
|
||||
Format.sprintf "%s"
|
||||
(Yojson.Safe.pretty_to_string (json_match_result_to_yojson { matches; source; id }))
|
||||
|
||||
let apply_rule substitute_in_place matcher rule =
|
||||
let open Option in
|
||||
let open Match in
|
||||
List.filter_map ~f:(fun ({ environment; _ } as matched) ->
|
||||
let inferred_equality_constraints =
|
||||
let vars = Environment.vars environment in
|
||||
List.fold vars ~init:[] ~f:(fun acc var ->
|
||||
if String.is_prefix var ~prefix:"equal_" then
|
||||
match String.split var ~on:'_' with
|
||||
| _equal :: target :: _uuid ->
|
||||
let expression = Language.Ast.Equal (Variable var, Variable target) in
|
||||
expression::acc
|
||||
| _ -> assert false
|
||||
else
|
||||
acc)
|
||||
in
|
||||
let sat, env =
|
||||
Rule.apply
|
||||
~newline_separated:(not substitute_in_place)
|
||||
(rule @ inferred_equality_constraints)
|
||||
~matcher
|
||||
environment
|
||||
in
|
||||
(if sat then env else None)
|
||||
>>| fun environment -> { matched with environment })
|
||||
|
||||
let check_too_long s =
|
||||
let n = String.length s in
|
||||
if n > max_request_length then
|
||||
@ -111,8 +81,8 @@ let perform_match request =
|
||||
if debug then Format.printf "Received %s@." (Yojson.Safe.pretty_to_string (match_request_to_yojson request));
|
||||
let matcher = Matchers.select_with_extension language in
|
||||
let run ?rule () =
|
||||
get_matches matcher source match_template
|
||||
|> Option.value_map rule ~default:ident ~f:(apply_rule false matcher)
|
||||
let configuration = Configuration.create ~match_kind:Fuzzy () in
|
||||
Pipeline.run matcher ?rule configuration match_template source
|
||||
|> matches_to_json source id
|
||||
in
|
||||
let code, result =
|
||||
@ -163,8 +133,8 @@ let perform_rewrite request =
|
||||
|> Yojson.Safe.pretty_to_string
|
||||
in
|
||||
let run ?rule () =
|
||||
get_matches matcher source match_template
|
||||
|> Option.value_map rule ~default:ident ~f:(apply_rule substitute_in_place matcher)
|
||||
let configuration = Configuration.create ~match_kind:Fuzzy () in
|
||||
Pipeline.run matcher ?rule ~newline_separated:(not substitute_in_place) configuration match_template source
|
||||
|> Rewrite.all ?source:source_substitution ~rewrite_template
|
||||
|> Option.value_map ~default ~f:(rewrite_to_json id)
|
||||
in
|
||||
@ -202,7 +172,7 @@ let () =
|
||||
Lwt.async_exception_hook := (function
|
||||
| Unix.Unix_error (error, func, arg) ->
|
||||
Logs.warn (fun m ->
|
||||
m "Client connection error %s: %s(%S)"
|
||||
m "Client connection error %s: %s(%S)"
|
||||
(Unix.error_message error) func arg
|
||||
)
|
||||
| exn -> Logs.err (fun m -> m "Unhandled exception: %a" Fmt.exn exn)
|
||||
|
@ -1,28 +1,23 @@
|
||||
open Core
|
||||
|
||||
open Language
|
||||
|
||||
type match_specification =
|
||||
{ match_template : string
|
||||
; rule : string
|
||||
; rule : Rule.t option
|
||||
}
|
||||
[@@deriving show]
|
||||
|
||||
type rewrite_specification =
|
||||
{ rewrite_template : string
|
||||
; rule : string
|
||||
; rule : Rule.t option
|
||||
}
|
||||
[@@deriving show]
|
||||
|
||||
type t =
|
||||
{ match_specification : match_specification
|
||||
; rewrite_specification : rewrite_specification option
|
||||
}
|
||||
[@@deriving show]
|
||||
|
||||
let create
|
||||
?rewrite_template
|
||||
?(rule = "where true")
|
||||
~match_template
|
||||
() =
|
||||
let create ?rewrite_template ?rule ~match_template () =
|
||||
let match_specification = { match_template; rule } in
|
||||
let rewrite_specification =
|
||||
Option.map rewrite_template ~f:(fun rewrite_template ->
|
||||
|
Loading…
Reference in New Issue
Block a user