comby-tools/comby
1
1
Fork 0
mirror of https://github.com/comby-tools/comby.git synced 2024-09-11 13:25:36 +03:00
Code Issues Packages Projects Releases Wiki Activity

Introduce simplified rewrite rule syntax

Browse Source
This commit is contained in:
Rijnard van Tonder 2019-09-13 02:24:49 -04:00 committed by GitHub
parent 99966c347c
commit 0b691c851c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
9 changed files with 152 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lib/language/ast.ml
View File

@ -15,7 +15,7 @@ type expression =
| Not_equal of atom * atom
| Match of atom * (antecedent * consequent) list
| RewriteTemplate of string
| Rewrite of atom * (antecedent * consequent) list
| Rewrite of atom * (antecedent * expression)
and consequent = expression list
[@@deriving sexp]

104
lib/language/rule.ml
View File

@ -33,7 +33,11 @@ let merge_match_environments matches environment' =
type rewrite_context =
{ variable : string }
let rec apply ?(matcher = (module Matchers.Generic : Matchers.Matcher)) predicates env =
let rec apply
?(matcher = (module Matchers.Generic : Matchers.Matcher))
?(newline_separated = false)
predicates
env =
let open Option in
let module Matcher = (val matcher : Matchers.Matcher) in
@ -111,42 +115,33 @@ let rec apply ?(matcher = (module Matchers.Generic : Matchers.Matcher)) predicat
in
true, env
end
| Rewrite (Variable variable, cases) ->
let result =
Environment.lookup env variable >>= fun source ->
List.find_map cases ~f:(fun (template, case_expression) ->
match template with
| String template ->
begin
let configuration = match_configuration_of_syntax template in
let matches = Matcher.all ~configuration ~template ~source in
if List.is_empty matches then
None
else
let fold_cases (sat, out) predicate =
if sat then
let env =
match out with
| Some out -> Environment.merge out env
| None -> env
in
match matches with
| { environment; _ } :: _ ->
let env = Environment.merge env environment in
rule_match ~rewrite_context:{ variable } env predicate
| _ ->
sat, out
else
(sat, out)
in
List.fold case_expression ~init:(true, None) ~f:fold_cases
|> Option.some
end
| Variable _ ->
failwith "| :[hole] is invalid. Maybe you meant to put quotes")
in
Option.value_map result ~f:ident ~default:(false, Some env)
| Rewrite _ -> failwith "TODO"
| Rewrite (Variable variable, (match_template, rewrite_expression)) ->
begin match rewrite_expression with
| RewriteTemplate rewrite_template ->
let template =
match match_template with
| Variable _ -> failwith "Invalid syntax in rewrite LHS"
| String template -> template
in
let result =
Environment.lookup env variable >>= fun source ->
let configuration = Configuration.create ~match_kind:Fuzzy () in
let matches = Matcher.all ~configuration ~template ~source in
let source = if newline_separated then None else Some source in
let result = Rewrite.all ?source ~rewrite_template matches in
match result with
| Some { rewritten_source; _ } ->
(* substitute for variables that are in the outside scope *)
let rewritten_source, _ = Rewrite_template.substitute rewritten_source env in
let env = Environment.update env variable rewritten_source in
return (true, Some env)
| None ->
return (true, Some env)
in
Option.value_map result ~f:ident ~default:(false, Some env)
| _ -> failwith "Not implemented yet"
end
| Rewrite _ -> failwith "TODO/Invalid: Have not decided whether rewrite \":[x]\" is useful."
in
List.fold predicates ~init:(true, None) ~f:(fun (sat, out) predicate ->
if sat then
@ -186,38 +181,43 @@ let create rule =
let false' = spaces >> string Syntax.false' << spaces |>> fun _ -> False in
let rec expression_parser s =
choice
[ pattern_parser
[ match_pattern_parser
; rewrite_pattern_parser
(* string literals are ambiguous, so attempt to parse operator first *)
; attempt operator_parser
; rewrite_template_parser
; true'
; false'
]
s
and pattern_parser s =
and match_pattern_parser s =
let case_parser : (atom * expression list, unit) parser =
spaces >> string Syntax.pipe_operator >>
spaces >> atom_parser << spaces << string Syntax.arrow << spaces >>= fun antecedent ->
spaces >> comma_sep expression_parser << spaces |>> fun consequent ->
antecedent, consequent
in
let pattern keyword =
string keyword << spaces >> atom_parser << spaces << char '{' << spaces
>>= fun atom ->
many1 case_parser
<< char '}' << spaces
>>= fun cases -> return (atom, cases)
in
let match_pattern =
let pattern keyword =
string keyword << spaces >> atom_parser << spaces << char '{' << spaces
>>= fun atom ->
many1 case_parser
<< char '}' << spaces
>>= fun cases -> return (atom, cases)
in
pattern Syntax.start_match_pattern |>> fun (atom, cases) ->
(Match (atom, cases))
Match (atom, cases)
in
match_pattern s
and rewrite_pattern_parser s =
let rewrite_pattern =
pattern Syntax.start_rewrite_pattern |>> fun (atom, cases) ->
(Rewrite (atom, cases))
string Syntax.start_rewrite_pattern << spaces >> atom_parser << spaces << char '{' << spaces
>>= fun atom ->
atom_parser << spaces << string Syntax.arrow << spaces >>= fun match_template ->
spaces >> rewrite_template_parser << char '}' << spaces
|>> fun rewrite_template ->
Rewrite (atom, (match_template, rewrite_template))
in
choice [ match_pattern; rewrite_pattern ]
s
rewrite_pattern s
in
let rule_parser s =
(spaces

1
lib/language/rule.mli
View File

@ -15,6 +15,7 @@ val create : string -> expression list Or_error.t
val apply
: ?matcher:(module Matcher)
-> ?newline_separated:bool
-> t
-> environment
-> result

27
src/command_configuration.ml
View File

@ -102,7 +102,7 @@ type output_options =
; json_pretty : bool
; json_lines : bool
; json_only_diff : bool
; in_place : bool
; file_in_place : bool
; diff : bool
; stdout : bool
; newline_separated : bool
@ -134,6 +134,7 @@ type run_options =
; match_timeout : int
; number_of_workers : int
; dump_statistics : bool
; newline_separate_rewrites : bool
}
type user_input =
@ -267,14 +268,14 @@ module Printer = struct
let convert output_options : replacement_output =
let output_format =
match output_options with
| { in_place = true; _ } -> Overwrite_file
| { file_in_place = true; _ } -> Overwrite_file
| { stdout = true; _ } -> Stdout
| { json_pretty = true; in_place = false; json_only_diff; _ } ->
| { json_pretty = true; file_in_place = false; json_only_diff; _ } ->
if json_only_diff then
Json_pretty Only_diff
else
Json_pretty Everything
| { json_lines = true; in_place = false; json_only_diff; _ } ->
| { json_lines = true; file_in_place = false; json_only_diff; _ } ->
if json_only_diff then
Json_lines Only_diff
else
@ -355,13 +356,13 @@ let validate_errors { input_options; run_options = _; output_options } =
let violations =
[ input_options.stdin && Option.is_some input_options.zip_file
, "-zip may not be used with stdin."
; output_options.in_place && is_some input_options.zip_file
; output_options.file_in_place && is_some input_options.zip_file
, "-in-place may not be used with -zip"
; output_options.in_place && output_options.stdout
; output_options.file_in_place && output_options.stdout
, "-in-place may not be used with stdout."
; output_options.in_place && output_options.diff
; output_options.file_in_place && output_options.diff
, "-in-place may not be used with -diff"
; output_options.in_place && (output_options.json_lines || output_options.json_pretty)
; output_options.file_in_place && (output_options.json_lines || output_options.json_pretty)
, "-in-place may not be used with -json-lines or -json-pretty"
; input_options.anonymous_arguments = None &&
(input_options.specification_directories = None
@ -423,7 +424,7 @@ let emit_warnings { input_options; output_options; _ } =
&& (output_options.stdout
|| output_options.json_pretty
|| output_options.json_lines
|| output_options.in_place)
|| output_options.file_in_place)
, "-color only works with -diff or -match-only"
; output_options.count && not input_options.match_only
, "-count only works with -match-only. Ignoring -count."
@ -453,9 +454,10 @@ let create
; match_timeout
; number_of_workers
; dump_statistics
; newline_separate_rewrites
}
; output_options =
({ in_place
({ file_in_place
; color
; _
} as output_options)
@ -503,8 +505,8 @@ let create
| Zip -> `Zip (Option.value_exn zip_file)
| Directory -> `Paths (parse_source_directories ?file_filters exclude_directory_prefix target_directory directory_depth)
in
let in_place = if input_source = Zip || input_source = Stdin then false else in_place in
let output_options = { output_options with in_place } in
let file_in_place = if input_source = Zip || input_source = Stdin then false else file_in_place in
let output_options = { output_options with file_in_place } in
let output_printer printable =
let open Printer in
match printable with
@ -531,6 +533,7 @@ let create
; match_timeout
; number_of_workers
; dump_statistics
; newline_separate_rewrites
}
; output_printer
}

3
src/command_configuration.mli
View File

@ -22,7 +22,7 @@ type output_options =
; json_pretty : bool
; json_lines : bool
; json_only_diff : bool
; in_place : bool
; file_in_place : bool
; diff : bool
; stdout : bool
; newline_separated : bool
@ -54,6 +54,7 @@ type run_options =
; match_timeout : int
; number_of_workers : int
; dump_statistics : bool
; newline_separate_rewrites : bool
}
type user_input =

38
src/main.ml
View File

@ -33,26 +33,22 @@ let get_matches (module Matcher : Matchers.Matcher) configuration match_template
Matcher.all ~configuration ~template:match_template ~source
|> List.filter ~f:(fun { environment; _ } -> Rule.(sat @@ apply rule ~matcher:(module Matcher) environment))
let apply_rewrite_rule matcher rewrite_rule matches =
let apply_rewrite_rule newline_separated matcher rewrite_rule matches =
let open Option in
match rewrite_rule with
| "" -> matches
| rewrite_rule ->
begin
match Rule.create rewrite_rule with
| Ok rule ->
List.filter_map matches ~f:(fun ({ environment; _ } as match_) ->
let sat, env = Rule.apply rule ~matcher environment in
(if sat then env else None)
>>| fun environment -> { match_ with environment })
| Error _ -> []
end
let rewrite rewrite_template _rewrite_rule source matches =
Rewrite.all ~source ~rewrite_template matches
match Rule.create rewrite_rule with
| Ok rule ->
List.filter_map matches ~f:(fun ({ environment; _ } as match_) ->
let sat, env = Rule.apply ~newline_separated rule ~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
configuration
source
specification
@ -93,13 +89,13 @@ let process_single_source
Matcher.all ~configuration ~template:match_template ~source:input_text
|> fun matches ->
(* TODO(RVT): merge match and rewrite rule application. *)
apply_rewrite_rule matcher rule matches
apply_rewrite_rule newline_separate_rule_rewrites matcher rule matches
|> fun matches ->
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 = [] }), [])
else
Some (rewrite rewrite_template rule input_text matches, matches)
Some (Rewrite.all ~source:input_text ~rewrite_template matches, matches)
in
Statistics.Time.time_out ~after:match_timeout f ();
with Statistics__Time.Time_out ->
@ -205,6 +201,7 @@ let run
; match_timeout
; number_of_workers
; dump_statistics
; newline_separate_rewrites
}
; output_printer
}
@ -222,7 +219,7 @@ let run
| Nothing | Matches _ -> input
| Replacement (_, content, _) -> `String content
in
process_single_source matcher match_configuration input specification verbose match_timeout
process_single_source matcher newline_separate_rewrites match_configuration input specification verbose match_timeout
|> function
| Nothing -> Nothing, count
| Matches (x, number_of_matches) ->
@ -368,7 +365,7 @@ let base_command_parameters : (unit -> 'result) Command.Param.t =
and json_pretty = flag "json-pretty" no_arg ~doc:"Output pretty JSON format"
and json_lines = flag "json-lines" no_arg ~doc:"Output JSON line format"
and json_only_diff = flag "json-only-diff" no_arg ~doc:"Output only the URI and diff in JSON line format"
and in_place = flag "in-place" no_arg ~doc:"Rewrite files on disk, in place"
and file_in_place = flag "in-place" no_arg ~doc:"Rewrite files on disk, in place"
and number_of_workers = flag "jobs" (optional_with_default 4 int) ~doc:"n Number of worker processes. Default: 4"
and dump_statistics = flag "statistics" ~aliases:["stats"] no_arg ~doc:"Dump statistics to stderr"
and stdin = flag "stdin" no_arg ~doc:"Read source from stdin"
@ -414,6 +411,7 @@ let base_command_parameters : (unit -> 'result) Command.Param.t =
{ match_template; rewrite_template; file_filters })
in
if list then list_supported_languages_and_exit ();
let newline_separate_rewrites = newline_separated in
let configuration =
Command_configuration.create
{ input_options =
@ -434,6 +432,7 @@ let base_command_parameters : (unit -> 'result) Command.Param.t =
; match_timeout
; number_of_workers
; dump_statistics
; newline_separate_rewrites
}
; output_options =
{ color
@ -441,7 +440,7 @@ let base_command_parameters : (unit -> 'result) Command.Param.t =
; json_pretty
; json_lines
; json_only_diff
; in_place
; file_in_place
; diff
; stdout
; newline_separated
@ -471,5 +470,4 @@ let default_command =
let () =
Scheduler.Daemon.check_entry_point ();
default_command
|> Command.run ~version:"0.7.0"
Command.run default_command ~version:"0.7.0"

4
test/test_cli.ml
View File

@ -205,7 +205,7 @@ let%expect_test "with_rewrite_rule" =
let source = "hello world" in
let match_template = ":[2] :[1]" in
let rewrite_template = ":[1]" in
let rule = {|where rewrite :[1] { | ":[_]" -> ":[2]" }|} in
let rule = {|where rewrite :[1] { ":[_]" -> ":[2]" }|} in
let command_args =
Format.sprintf "-stdin -sequential '%s' '%s' -rule '%s' -f .c "
match_template rewrite_template rule
@ -223,7 +223,7 @@ let%expect_test "with_rewrite_rule_stdin_default_no_extension" =
let source = "hello world" in
let match_template = ":[2] :[1]" in
let rewrite_template = ":[1]" in
let rule = {|where rewrite :[1] { | ":[_]" -> ":[2]" }|} in
let rule = {|where rewrite :[1] { ":[_]" -> ":[2]" }|} in
let command_args =
Format.sprintf "-sequential '%s' '%s' -rule '%s' -stdin" match_template rewrite_template rule
in

163
test/test_rewrite_rule.ml
View File

@ -41,9 +41,7 @@ let%expect_test "rewrite_rule" =
let rule =
{|
where rewrite :[1] {
| "int" -> "expect"
}
where rewrite :[1] { "int" -> "expect" }
|}
|> Rule.create
|> Or_error.ok_exn
@ -52,100 +50,6 @@ let%expect_test "rewrite_rule" =
run_rule source match_template rewrite_template rule;
[%expect_exact {|expect|}]
let%expect_test "rewrite_rule" =
let source = {|string expect|} in
let match_template = {|:[1] :[2]|} in
let rewrite_template = {|:[2]|} in
let rule =
{|
where rewrite :[1] {
| "int" -> "5"
| "string" -> ":[2]"
}
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule source match_template rewrite_template rule;
[%expect_exact {|expect|}]
let%expect_test "conditional_rewrite_rule" =
let source = {|{ { a : { b : { c : d } } } }|} in
let match_template = {|:[1]|} in
let rewrite_template = {|:[1]|} in
let rule =
{|
where rewrite :[1] {
| "{ :[a] : :[rest] }" -> "a" == :[a], "doot"
}
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule source match_template rewrite_template rule;
[%expect_exact {|doot|}]
let%expect_test "rewrite_rule_using_match_result" =
let source = {|{ { a : { b : { c : d } } } }|} in
let match_template = {|:[1]|} in
let rewrite_template = {|:[1]|} in
let rule =
{|
where rewrite :[1] {
| "{ :[a] : :[rest] }" -> "a" == :[a], ":[rest]"
}
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule source match_template rewrite_template rule;
[%expect_exact {|{ b : { c : d } }|}];
let source = {|{ { a : { b : { c : d } } } }|} in
let match_template = {|:[1]|} in
let rewrite_template = {|:[1]|} in
let rule =
{|
where rewrite :[1] {
| "{ :[a] : :[rest] }" -> "b" == :[a], ":[rest]"
}
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule source match_template rewrite_template rule;
[%expect_exact {|{ { a : { b : { c : d } } } }|}]
let%expect_test "nested_rewrite_rule" =
let source = {|{ { a : { b : { c : d } } } }|} in
let match_template = {|:[1]|} in
let rewrite_template = {|:[1]|} in
let rule =
{|
where
rewrite :[1] {
| "{ :[a] : :[rest] }" ->
rewrite :[a] {
| "a" -> "b"
}, "{ :[a] : :[rest] }"
}
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule source match_template rewrite_template rule;
[%expect_exact {|{ b : { b : { c : d } } }|}]
let%expect_test "sequenced_rewrite_rule" =
let source = {|{ { a : { b : { c : d } } } }|} in
let match_template = {|{ :[a] : :[rest] }|} in
@ -154,12 +58,8 @@ let%expect_test "sequenced_rewrite_rule" =
let rule =
{|
where
rewrite :[a] {
| "a" -> "qqq"
},
rewrite :[rest] {
| "{ b : { :[other] } }" -> "{ :[other] }"
}
rewrite :[a] { "a" -> "qqq" },
rewrite :[rest] { "{ b : { :[other] } }" -> "{ :[other] }" }
|}
|> Rule.create
|> Or_error.ok_exn
@ -167,3 +67,60 @@ let%expect_test "sequenced_rewrite_rule" =
run_rule source match_template rewrite_template rule;
[%expect_exact {|{ { qqq : { c : d } } }|}]
let%expect_test "rewrite_rule_for_list" =
let source = {|[1, 2, 3, 4,]|} in
let match_template = {|[:[contents]]|} in
let rewrite_template = {|[:[contents]]|} in
let rule =
{|
where rewrite :[contents] { ":[[x]]," -> ":[[x]];" }
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule source match_template rewrite_template rule;
[%expect_exact {|[1; 2; 3; 4;]|}]
let%expect_test "rewrite_rule_for_list_strip_last" =
let source = {|[1, 2, 3, 4]|} in
let match_template = {|[:[contents]]|} in
let rewrite_template = {|[:[contents]]|} in
let rule =
{|
where rewrite :[contents] { ":[x], " -> ":[x]; " }
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule source match_template rewrite_template rule;
[%expect_exact {|[1; 2; 3; 4]|}]
let%expect_test "haskell_example" =
let source = {|
(concat
[ "blah blah blah"
, "blah"
])
|} in
let match_template = {|(concat [:[contents]])|} in
let rewrite_template = {|(:[contents])|} in
let rule =
{|
where rewrite :[contents] { "," -> "++" }
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule source match_template rewrite_template rule;
[%expect_exact {|
( "blah blah blah"
++ "blah"
)
|}]

2
test/test_server.ml
View File

@ -122,7 +122,7 @@ let%expect_test "post_request" =
Error in line 1, column 7:
where :[1] = "world"
^
Expecting "false", "match", "rewrite", "true" or string literal
Expecting "false", "match", "rewrite" or "true"
Backtracking occurred after:
Error in line 1, column 12:
where :[1] = "world"