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

simple script parser and rule syntax additions (#273)

Browse Source
This commit is contained in:
Rijnard van Tonder 2021-04-10 19:36:59 -07:00 committed by GitHub
parent 5863b9208c
commit b1e29ce339
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
29 changed files with 712 additions and 448 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lib/app/comby.ml
View File

@ -27,7 +27,7 @@ module Rule = struct
let sat = Rule.Alpha.sat
let result_env = Rule.Alpha.result_env
let create = Rule.Alpha.create
let create = Rule.create
let apply = Rule.Alpha.apply
end
type rule = Rule.t

50
lib/app/configuration/command_configuration.ml
View File

@ -1,5 +1,4 @@
open Core
open Toml
open Camlzip
open Polymorphic_compare
@ -105,23 +104,17 @@ let read filename =
String.chop_suffix template ~suffix:"\n"
|> Option.value ~default:template
let create_rule omega rule =
let create =
if omega then
Rule.Omega.create
else
Rule.Alpha.create
in
match Option.map rule ~f:create with
let create_rule 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
let parse_toml omega path =
let parse_toml path =
let open Toml.Types in
let toml = Parser.(from_filename path |> unsafe) in
let toml = Toml.Parser.(from_filename path |> unsafe) in
let toml = Table.remove (Toml.Min.key "flags") toml in
let to_specification (key : Table.key) (value : Toml.Types.value) acc =
let name = Table.Key.to_string key in
@ -142,7 +135,7 @@ let parse_toml omega path =
Format.eprintf "A 'match' key is required for entry %s@." name;
exit 1
in
let rule = Table.find_opt (Toml.Min.key "rule") t |> to_string |> create_rule omega in
let rule = Table.find_opt (Toml.Min.key "rule") t |> to_string |> create_rule in
let rewrite_template = Table.find_opt (Toml.Min.key "rewrite") t |> to_string in
if debug then Format.printf "Processed ->%s<-@." match_template;
(name, (Specification.create ~match_template ?rule ?rewrite_template ()))::acc
@ -154,7 +147,7 @@ let parse_toml omega path =
|> List.sort ~compare:(fun x y -> String.compare (fst x) (fst y))
|> List.map ~f:snd
let parse_templates ?(warn_for_missing_file_in_dir = false) omega paths =
let parse_templates ?(warn_for_missing_file_in_dir = false) paths =
let parse_directory path =
let read_optional filename =
match read filename with
@ -166,7 +159,7 @@ let parse_templates ?(warn_for_missing_file_in_dir = false) omega paths =
if warn_for_missing_file_in_dir then Format.eprintf "WARNING: Could not read required match file in %s@." path;
None
| Some match_template ->
let rule = create_rule omega @@ read_optional (path ^/ "rule") in
let rule = create_rule @@ read_optional (path ^/ "rule") in
let rewrite_template = read_optional (path ^/ "rewrite") in
Specification.create ~match_template ?rule ?rewrite_template ()
|> Option.some
@ -188,7 +181,7 @@ let parse_templates ?(warn_for_missing_file_in_dir = false) omega paths =
if Sys.is_directory path = `Yes then
fold_directory path ~sorted:true ~init:[] ~f
else
parse_toml omega path)
parse_toml path)
type interactive_review =
{ editor : string
@ -444,7 +437,7 @@ type t =
; metasyntax : Matchers.Metasyntax.t option
}
let emit_errors { input_options; run_options; output_options } =
let emit_errors { input_options; output_options; _ } =
let error_on =
[ input_options.stdin && Option.is_some input_options.zip_file
, "-zip may not be used with -stdin."
@ -492,7 +485,7 @@ let emit_errors { input_options; run_options; output_options } =
| Some inputs ->
List.find_map inputs ~f:(fun input ->
if Sys.is_file input = `Yes then
(match Parser.from_filename input with
(match Toml.Parser.from_filename input with
| `Error (s, _) -> Some s
| _ -> None)
else if not (Sys.is_directory input = `Yes) then
@ -506,12 +499,7 @@ let emit_errors { input_options; run_options; output_options } =
Option.value_exn message
else
"UNREACHABLE")
; (let result =
if run_options.omega then
Rule.Omega.create input_options.rule
else
Rule.Alpha.create input_options.rule
in
; (let result = Rule.create input_options.rule in
Or_error.is_error result
, if Or_error.is_error result then
Format.sprintf "Match rule parse error: %s@." @@
@ -540,14 +528,14 @@ let emit_errors { input_options; run_options; output_options } =
in
Error.of_string message)
let emit_warnings { input_options; run_options; output_options } =
let emit_warnings { input_options; output_options; _ } =
let warn_on =
[ (let match_templates =
match input_options.templates, input_options.anonymous_arguments with
| None, Some { match_template; _ } ->
[ match_template ]
| Some templates, _ ->
List.map (parse_templates run_options.omega templates) ~f:(fun { match_template; _ } -> match_template)
List.map (parse_templates templates) ~f:(fun { match_template; _ } -> match_template)
| _ -> assert false
in
List.exists match_templates ~f:(fun match_template ->
@ -744,14 +732,8 @@ let create
emit_errors configuration >>= fun () ->
emit_warnings configuration >>= fun () ->
let rule =
let create =
if omega then
Rule.Omega.create
else
Rule.Alpha.create
in
let rule = String.substr_replace_all rule ~pattern:"..." ~with_:":[_]" in
create rule |> Or_error.ok_exn
Rule.create rule |> Or_error.ok_exn
in
let specifications =
match templates, anonymous_arguments with
@ -761,7 +743,7 @@ let create
else
[ Specification.create ~match_template ~rewrite_template ~rule () ]
| Some templates, _ ->
parse_templates ~warn_for_missing_file_in_dir:true omega templates
parse_templates ~warn_for_missing_file_in_dir:true templates
| _ -> assert false
in
let specifications =
@ -771,7 +753,7 @@ let create
in
let specifications =
if match_only then
List.map specifications ~f:(fun {match_template; rule; _ } ->
List.map specifications ~f:(fun { match_template; rule; _ } ->
Specification.create ~match_template ?rule ())
else
specifications

3
lib/kernel/comby_kernel.ml
View File

@ -27,9 +27,10 @@ module Rule = struct
let sat = Rule.Alpha.sat
let result_env = Rule.Alpha.result_env
let create = Rule.Alpha.create
let create = Rule.create
let apply = Rule.Alpha.apply
end
type rule = Rule.t
module Replacement = Replacement

25
lib/kernel/language/alpha_parser.ml
View File

@ -1,25 +0,0 @@
open Core_kernel
open MParser
open MParser_PCRE.Tokens
open Ast
let variable_parser s =
(string Syntax.variable_left_delimiter
>> (many (alphanum <|> char '_') |>> String.of_char_list)
<< string Syntax.variable_right_delimiter) s
let value_parser s =
string_literal s
let operator_parser s =
((string Syntax.equal)
<|> (string Syntax.not_equal)) s
let atom_parser s =
((variable_parser >>= fun variable -> return (Variable variable))
<|> (value_parser >>= fun value -> return (String value))) s
let rewrite_template_parser s =
(value_parser >>= fun value -> return (RewriteTemplate value)) s

82
lib/kernel/language/alpha_rule.ml
View File

@ -1,12 +1,9 @@
open Core_kernel
open MParser
open MParser_PCRE.Tokens
open Match
open Rewriter
open Ast
open Alpha_parser
module Configuration = Matchers.Configuration
@ -167,82 +164,3 @@ let rec apply
rule_match env predicate
else
(sat, out))
let make_equality_expression operator left right =
if String.equal operator Syntax.equal then
return (Equal (left, right))
else if
String.equal operator Syntax.not_equal then
return (Not_equal (left, right))
else
let message =
Format.sprintf
"Unhandled operator %s. Did you mean %s or %s?"
operator
Syntax.equal
Syntax.not_equal in
fail message
let create rule =
let operator_parser =
spaces >> atom_parser >>= fun left ->
spaces >> operator_parser >>= fun operator ->
spaces >> atom_parser << spaces >>= fun right ->
make_equality_expression operator left right << spaces
in
let true' = spaces >> string Syntax.true' << spaces |>> fun _ -> True in
let false' = spaces >> string Syntax.false' << spaces |>> fun _ -> False in
let option_parser = spaces >> string Syntax.option_nested << spaces |>> fun _ -> Option "nested" in
let rec expression_parser s =
choice
[ match_pattern_parser
; rewrite_pattern_parser
(* string literals are ambiguous, so attempt to parse operator first *)
; attempt operator_parser
; true'
; false'
; option_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 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)
in
match_pattern s
and rewrite_pattern_parser s =
let rewrite_pattern =
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
rewrite_pattern s
in
let rule_parser s =
(spaces
>> string Syntax.rule_prefix
>> spaces1
>> comma_sep1 expression_parser
<< eof)
s
in
match parse_string rule_parser rule () with
| Success rule -> Ok rule
| Failed (error, _) -> Or_error.error_string error

28
lib/kernel/language/ast.ml
View File

@ -26,3 +26,31 @@ let (<>) left right = Not_equal (left, right)
type t = expression list
[@@deriving sexp]
module Script = struct
module Specification = struct
type t =
{ match_template : string
; rule : expression list option
; rewrite_template : string option
}
[@@deriving sexp]
end
type spec = Specification.t
[@@deriving sexp]
type op =
| And
| Or
| Not
[@@deriving sexp]
type exp =
| Exp of op * exp list
| Spec of spec
[@@deriving sexp]
type t = exp list
[@@deriving sexp]
end

47
lib/kernel/language/omega_parser.ml
View File

@ -1,47 +0,0 @@
open Core_kernel
open Angstrom
open Ast
let (|>>) p f =
p >>= fun x -> return (f x)
let alphanum =
satisfy (function
| 'a' .. 'z'
| 'A' .. 'Z'
| '0' .. '9' -> true
| _ -> false)
let variable_parser =
(string Syntax.variable_left_delimiter
*> (many (alphanum <|> char '_') |>> String.of_char_list)
<* string Syntax.variable_right_delimiter)
let escaped_char_s =
any_char
let char_token_s =
(char '\\' *> escaped_char_s >>= fun c -> return (Format.sprintf {|\%c|} c))
<|> (any_char |>> String.of_char)
let value_parser =
(string {|"|}
*> (many_till char_token_s (string {|"|})))
|>> String.concat
let operator_parser =
choice
[ string Syntax.equal
; string Syntax.not_equal
]
let atom_parser =
choice
[ (variable_parser >>= fun variable -> return (Variable variable))
; (value_parser >>= fun value -> return (String value))
]
let rewrite_template_parser =
value_parser >>= fun value -> return (RewriteTemplate value)

90
lib/kernel/language/omega_rule.ml
View File

@ -1,11 +1,11 @@
open Core_kernel
open Angstrom
open Ast
open Match
open Rewriter
open Ast
open Omega_parser
module Configuration = Matchers.Configuration
@ -169,89 +169,3 @@ let rec apply
rule_match env predicate
else
(sat, out))
let make_equality_expression operator left right =
if String.equal operator Syntax.equal then
return (Equal (left, right))
else if
String.equal operator Syntax.not_equal then
return (Not_equal (left, right))
else
let message =
Format.sprintf
"Unhandled operator %s. Did you mean %s or %s?"
operator
Syntax.equal
Syntax.not_equal in
fail message
let is_whitespace = function
| ' ' | '\t' | '\r' | '\n' -> true
| _ -> false
let spaces =
take_while is_whitespace >>= fun s ->
return s
let spaces1 =
satisfy is_whitespace >>= fun c ->
take_while is_whitespace >>= fun s ->
return (Format.sprintf "%c%s" c s)
let create rule =
let operator_parser =
spaces *> atom_parser >>= fun left ->
spaces *> operator_parser >>= fun operator ->
spaces *> atom_parser >>= fun right ->
make_equality_expression operator left right <* spaces
in
let true' = spaces *> string Syntax.true' <* spaces |>> fun _ -> True in
let false' = spaces *> string Syntax.false' <* spaces |>> fun _ -> False in
let option_parser = spaces *> string Syntax.option_nested <* spaces |>> fun _ -> Option "nested" in
let expression_parser =
fix (fun expression_parser ->
let match_pattern_parser =
let case_parser =
spaces *> string Syntax.pipe_operator *>
spaces *> atom_parser <* spaces <* string Syntax.arrow <* spaces >>= fun antecedent ->
spaces *> sep_by (char ',') 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
pattern Syntax.start_match_pattern |>> fun (atom, cases) ->
Match (atom, cases)
in
let rewrite_pattern_parser =
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 <* spaces <* char '}' <* spaces
|>> fun rewrite_template ->
Rewrite (atom, (match_template, rewrite_template))
in
choice
[ match_pattern_parser
; rewrite_pattern_parser
; operator_parser
; true'
; false'
; option_parser
])
in
let rule_parser =
spaces
*> string Syntax.rule_prefix
*> spaces1
*> sep_by1 (spaces *> char ',' <* spaces) expression_parser
<* end_of_input
in
match parse_string ~consume:All rule_parser rule with
| Ok rule -> Ok rule
| Error error -> Or_error.error_string error

195
lib/kernel/language/parser.ml Normal file
View File

@ -0,0 +1,195 @@
open Core_kernel
open Angstrom
open Ast
let alphanum =
satisfy (function
| 'a' .. 'z'
| 'A' .. 'Z'
| '0' .. '9' -> true
| _ -> false)
let variable_parser =
(string Syntax.variable_left_delimiter
*> (many (alphanum <|> char '_') >>| String.of_char_list)
<* string Syntax.variable_right_delimiter)
(** Interpret escape sequences inside quotes *)
let char_token_s =
(char '\\' *> any_char >>|
function
| 'r' -> Char.to_string '\r'
| 'n' -> Char.to_string '\n'
| 't' -> Char.to_string '\t'
| '\\' -> Char.to_string '\\'
| c -> Format.sprintf {|\%c|} c)
<|> (any_char >>| String.of_char)
(** With escape sequences *)
let quote s =
(string s *> (many_till char_token_s (string s)))
>>| String.concat
let raw s =
(string s *> (many_till any_char (string s)))
>>| String.of_char_list
let quoted_parser =
choice [ quote {|"|}; quote {|'|}; raw {|`|} ]
let operator_parser =
choice
[ string Syntax.equal
; string Syntax.not_equal
]
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"
let value_parser ~reserved () =
match reserved with
| [] -> fail "no value allowed to scan here"
| reserved -> many (any_char_except ~reserved)
let map_special s =
if String.is_prefix s ~prefix:"~" then
Variable (Format.sprintf ":[%s]" s)
else if String.equal s "_" then
Variable ":[_]"
else
String s
let antecedent_parser ?(reserved = []) () =
choice
[ (quoted_parser >>| fun value -> String value)
; (value_parser ~reserved () >>| fun value -> map_special (String.of_char_list value))
]
let atom_parser ?(reserved = []) () =
choice
[ (variable_parser >>| fun variable -> Variable variable)
; (quoted_parser >>| fun value -> String value)
; (value_parser ~reserved () >>| fun value -> String (String.of_char_list value))
]
let rewrite_template_parser =
quoted_parser >>| fun value -> RewriteTemplate value
let ignore p =
p *> return ()
let make_equality_expression left operator right =
if String.equal operator Syntax.equal then
Equal (left, right)
else
Not_equal (left, right)
let is_whitespace = function
| ' ' | '\t' | '\r' | '\n' -> true
| _ -> false
let spaces =
take_while is_whitespace
let spaces1 =
satisfy is_whitespace *>
take_while is_whitespace *>
return ()
let optional_trailing c = option () (skip (Char.equal c))
let option_parser = spaces *> string Syntax.option_nested <* spaces >>| fun _ -> Option "nested"
let true' = lift (fun _ -> True) (spaces *> string Syntax.true' <* spaces)
let false' = lift (fun _ -> False) (spaces *> string Syntax.false' <* spaces)
(** <atom> [==, !=] <atom> *)
let operator_parser =
lift3
make_equality_expression
(spaces *> atom_parser ())
(spaces *> operator_parser)
(spaces *> atom_parser ())
<* spaces
let make_rewrite_expression atom match_template rewrite_template =
Rewrite (atom, (match_template, rewrite_template))
let make_match_expression atom cases =
Match (atom, cases)
(** rewrite <atom> { <atom> -> <atom> } *)
let rewrite_pattern_parser =
lift3
make_rewrite_expression
(string Syntax.start_rewrite_pattern *> spaces *> atom_parser () <* spaces <* char '{' <* spaces)
(antecedent_parser ~reserved:[" ->"] () <* spaces <* string Syntax.arrow <* spaces)
(spaces *> rewrite_template_parser <* spaces <* char '}' <* spaces)
(** <atom> -> atom [, <expr>], [,] *)
let match_arrow_parser expression_parser =
both
(antecedent_parser ~reserved:[" ->"] () <* spaces <* string Syntax.arrow <* spaces)
(spaces *> sep_by (char ',') expression_parser <* spaces <* optional_trailing ',' <* spaces)
(** [|] <match_arrow> *)
let first_case_parser expression_parser =
spaces *> option () (ignore @@ string Syntax.pipe_operator *> spaces) *>
match_arrow_parser expression_parser
(** | <match_arrow> *)
let case_parser expression_parser =
spaces *> string Syntax.pipe_operator *> spaces *>
match_arrow_parser expression_parser
(** [|] <match_arrow> | <match_arrow> *)
let case_block expression_parser =
first_case_parser expression_parser >>= fun case ->
many (case_parser expression_parser) >>= fun cases ->
return (case :: cases)
(** match <atom> { <case_parser> } *)
let match_pattern_parser expression_parser =
string Syntax.start_match_pattern *> spaces *>
lift2
make_match_expression
(atom_parser () <* spaces <* char '{' <* spaces)
(case_block expression_parser <* char '}' <* spaces)
let expression_parser =
fix (fun expression_parser ->
choice
[ match_pattern_parser expression_parser
; rewrite_pattern_parser
; operator_parser
; true'
; false'
; option_parser
])
(** where <expression> [,] *)
let parse =
spaces *> string Syntax.rule_prefix *>
spaces1 *> sep_by1 (spaces *> char ',' <* spaces) expression_parser
<* optional_trailing ','
<* spaces
let create rule =
match parse_string ~consume:All (parse <* end_of_input) rule with
| Ok rule -> Ok rule
| Error error -> Or_error.error_string error

2
lib/kernel/language/rule.ml
View File

@ -1,4 +1,6 @@
include Types
let create = Parser.create
module Alpha = Alpha_rule
module Omega = Omega_rule

4
lib/kernel/language/rule.mli
View File

@ -1,4 +1,8 @@
open Core_kernel
include module type of Types
val create : string -> t Or_error.t
module Alpha : Engine
module Omega : Engine

59
lib/kernel/language/script.ml Normal file
View File

@ -0,0 +1,59 @@
open Angstrom
open Parser
open Ast
open Script
let ignore p =
p *> return ()
let spaces = many @@ satisfy (function ' ' | '\n' | '\r' | '\t' -> true | _ -> false)
let spaces1 = many1 @@ satisfy (function ' ' | '\n' | '\r' | '\t' -> true | _ -> false)
let optional s = option () (ignore @@ string s)
let chainl1 e op =
let rec parse acc = (lift2 (fun f x -> f acc x) op e >>= parse) <|> return acc in
e >>= fun init -> parse init
let parens p = char '(' *> (p <|> return []) <* char ')'
let spec =
let match_rewrite_parser =
both
(spaces *> atom_parser ())
(option None (spaces *> string Syntax.arrow *> spaces *> atom_parser () >>| fun x -> Some x))
in
match_rewrite_parser >>= fun (match_template_atom, rewrite_template_atom) ->
(option None (spaces1 *> Parser.parse >>| fun x -> Some x)) >>= fun rule ->
let match_template = Sexplib.Sexp.to_string_hum (sexp_of_atom match_template_atom) in
let rewrite_template =
match rewrite_template_atom with
| Some rewrite_template_atom -> Some (Sexplib.Sexp.to_string_hum (sexp_of_atom rewrite_template_atom))
| None -> None
in
return [(Spec (Specification.{ match_template; rule; rewrite_template }))]
let unop syntax exp_parser =
choice (List.map string syntax) *> spaces *> exp_parser >>| fun exp -> [Exp (Not, exp)]
let binop syntax op =
spaces *> choice (List.map string syntax) *> spaces *> return (fun left right -> [Exp (op, left@right)])
let exp_parser =
fix (fun exp ->
let exp_parser = fix (fun exp' -> parens exp <|> unop ["NOT"; "not"] exp' <|> spec) in
let and_parser = chainl1 exp_parser @@ binop ["AND"; "and"] And in
let seq_parser = chainl1 and_parser @@ binop ["OR"; "or"] Or in
sep_by1 (spaces *> string Syntax.separator <* spaces) seq_parser >>| List.concat)
let parser =
spaces *> optional Syntax.separator *>
exp_parser <* optional Syntax.separator <* spaces <* end_of_input
let parse script =
parse_string ~consume:All parser script
let to_string exp =
Sexplib.Sexp.to_string_hum (Script.sexp_of_t exp)

2
lib/kernel/language/syntax.ml
View File

@ -10,3 +10,5 @@ let false' = "false"
let option_nested = "nested"
let pipe_operator = "|"
let arrow = "->"
let separator = "---"

4
lib/kernel/language/types.ml
View File

@ -1,5 +1,3 @@
open Core_kernel
open Matchers
open Match
@ -16,8 +14,6 @@ module type Engine = sig
val result_env : result -> environment option
val create : string -> t Or_error.t
val apply
: ?matcher:(module Matcher.S)
-> ?substitute_in_place:bool

4
test/alpha/test_regex_holes.ml
View File

@ -9,8 +9,8 @@ let configuration = Matchers.Configuration.create ~match_kind:Fuzzy ()
let run ?(configuration = configuration) (module M : Matchers.Matcher.S) source match_template ?rule rewrite_template =
let rule =
match rule with
| Some rule -> Language.Rule.Alpha.create rule |> Or_error.ok_exn
| None -> Language.Rule.Alpha.create "where true" |> Or_error.ok_exn
| Some rule -> Language.Rule.create rule |> Or_error.ok_exn
| None -> Language.Rule.create "where true" |> Or_error.ok_exn
in
M.all ~configuration ~template:match_template ~source ()
|> List.filter ~f:(fun { Match.environment; _ } -> Language.Rule.Alpha.(sat @@ apply rule environment))

4
test/common/dune
View File

@ -2,8 +2,9 @@
(name common_test_integration)
(package comby)
(modules
test_cli_helper
test_helpers
test_cli_helper
test_script
test_extract_regex
test_alpha
test_omega
@ -12,6 +13,7 @@
; test_server
test_statistics
test_offset_conversion
test_parse_rule
test_rewrite_rule_alpha
test_rewrite_rule_omega

1
test/common/test_alpha.ml
View File

@ -1,4 +1,5 @@
open Language
include Matchers.Alpha
let create = Language.Rule.create
module Rule = Rule.Alpha

2
test/common/test_go_alpha.ml
View File

@ -8,7 +8,7 @@ open Test_helpers
include Test_alpha
let run ?(rule = "where true") source match_template rewrite_template =
let rule = Rule.create rule |> Or_error.ok_exn in
let rule = Language.Rule.create rule |> Or_error.ok_exn in
Go.first ~configuration match_template source
|> function
| Ok ({environment; _ } as result) ->

2
test/common/test_go_omega.ml
View File

@ -8,7 +8,7 @@ open Test_helpers
include Test_omega
let run ?(rule = "where true") source match_template rewrite_template =
let rule = Rule.create rule |> Or_error.ok_exn in
let rule = Language.Rule.create rule |> Or_error.ok_exn in
Go.first ~configuration match_template source
|> function
| Ok ({environment; _ } as result) ->

93
test/common/test_match_rule_alpha.ml
View File

@ -1,6 +1,5 @@
open Core
open Language
open Matchers
open Match
@ -8,62 +7,8 @@ open Test_helpers
include Test_alpha
let rule_parses rule =
match Rule.create rule with
| Ok _ -> "true"
| Error _ -> "false"
let%expect_test "parse_rule" =
let rule = {| where :[1] == :[2], :[3] == "y" |} in
rule_parses rule |> print_string;
[%expect_exact {|true|}];
let rule = {| where :[1] == :[2], :[3] != "x" |} in
rule_parses rule |> print_string;
[%expect_exact {|true|}];
let rule = {| where :[1] != :[3] |} in
rule_parses rule |> print_string;
[%expect_exact {|true|}]
let%expect_test "parse_basic" =
Rule.create {|where "a" == "a"|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact {|(rule ((Equal (String a) (String a))))
|}]
let%expect_test "parse_option_nested" =
Rule.create {|where nested, "a" == "a" |}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact {|(rule ((Option nested) (Equal (String a) (String a))))
|}]
let%expect_test "parse_match_one_case" =
Rule.create {|where match "match_me" { | "case_one" -> true }|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule ((Match (String match_me) (((String case_one) (True))))))
"]
let%expect_test "parse_match_multi_case" =
Rule.create
{| where
match "match_me" {
| "case_one" -> true
| "case_two" -> false
}
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule
((Match (String match_me)
(((String case_one) (True)) ((String case_two) (False))))))
"]
let sat ?(env = Environment.create ()) rule =
let rule = Rule.create rule |> Or_error.ok_exn in
let rule = create rule |> Or_error.ok_exn in
Format.sprintf "%b" (Rule.(sat @@ apply rule env))
let make_env bindings =
@ -146,7 +91,7 @@ let%expect_test "where_true" =
let rule =
{| where true
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -195,7 +140,7 @@ let%expect_test "match_sat" =
| ":[_],:[_]" -> false
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -211,7 +156,7 @@ let%expect_test "match_sat" =
| ":[_],:[_]" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -254,7 +199,7 @@ let%expect_test "match_sat" =
| ":[_]" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -290,7 +235,7 @@ let%expect_test "match_sat" =
| ":[_]" -> :[1] == "a"
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -325,7 +270,7 @@ let%expect_test "match_sat" =
| ":[_]" -> :[1] == "b"
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -344,7 +289,7 @@ let%expect_test "match_s_suffix" =
let rule =
{| where true
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -380,7 +325,7 @@ let%expect_test "match_s_suffix" =
let rule =
{| where true
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -418,7 +363,7 @@ let%expect_test "configuration_choice_based_on_case" =
| "ame" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -437,7 +382,7 @@ let%expect_test "configuration_choice_based_on_case" =
| "names" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -474,7 +419,7 @@ let%expect_test "configuration_choice_based_on_case" =
| "names" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -495,7 +440,7 @@ let%expect_test "match_using_environment_merge" =
let rule =
{| where match :[1] { | "{ :[x] : :[y] }" -> :[x] == :[y] }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -530,7 +475,7 @@ let%expect_test "match_using_environment_merge" =
let rule =
{| where match :[1] { | "{ :[x] : :[y] }" -> :[x] == :[y] }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -555,7 +500,7 @@ let%expect_test "nested_matches" =
}
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -596,7 +541,7 @@ let%expect_test "nested_matches" =
}
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -617,7 +562,7 @@ let%expect_test "match_on_template" =
| "poodles" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -654,7 +599,7 @@ let%expect_test "match_on_template" =
| "poodles" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -691,7 +636,7 @@ let%expect_test "match_on_template" =
| "poodle" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in

93
test/common/test_match_rule_omega.ml
View File

@ -1,6 +1,5 @@
open Core
open Language
open Matchers
open Match
@ -8,62 +7,8 @@ open Test_helpers
include Test_omega
let rule_parses rule =
match Rule.create rule with
| Ok _ -> "true"
| Error _ -> "false"
let%expect_test "parse_rule" =
let rule = {| where :[1] == :[2], :[3] == "y" |} in
rule_parses rule |> print_string;
[%expect_exact {|true|}];
let rule = {| where :[1] == :[2], :[3] != "x" |} in
rule_parses rule |> print_string;
[%expect_exact {|true|}];
let rule = {| where :[1] != :[3] |} in
rule_parses rule |> print_string;
[%expect_exact {|true|}]
let%expect_test "parse_basic" =
Rule.create {|where "a" == "a"|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact {|(rule ((Equal (String a) (String a))))
|}]
let%expect_test "parse_option_nested" =
Rule.create {|where nested, "a" == "a" |}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact {|(rule ((Option nested) (Equal (String a) (String a))))
|}]
let%expect_test "parse_match_one_case" =
Rule.create {|where match "match_me" { | "case_one" -> true }|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule ((Match (String match_me) (((String case_one) (True))))))
"]
let%expect_test "parse_match_multi_case" =
Rule.create
{| where
match "match_me" {
| "case_one" -> true
| "case_two" -> false
}
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule
((Match (String match_me)
(((String case_one) (True)) ((String case_two) (False))))))
"]
let sat ?(env = Environment.create ()) rule =
let rule = Rule.create rule |> Or_error.ok_exn in
let rule = create rule |> Or_error.ok_exn in
Format.sprintf "%b" (Rule.(sat @@ apply rule env))
let make_env bindings =
@ -146,7 +91,7 @@ let%expect_test "where_true" =
let rule =
{| where true
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -195,7 +140,7 @@ let%expect_test "match_sat" =
| ":[_],:[_]" -> false
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -211,7 +156,7 @@ let%expect_test "match_sat" =
| ":[_],:[_]" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -254,7 +199,7 @@ let%expect_test "match_sat" =
| ":[_]" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -290,7 +235,7 @@ let%expect_test "match_sat" =
| ":[_]" -> :[1] == "a"
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -325,7 +270,7 @@ let%expect_test "match_sat" =
| ":[_]" -> :[1] == "b"
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -344,7 +289,7 @@ let%expect_test "match_s_suffix" =
let rule =
{| where true
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -380,7 +325,7 @@ let%expect_test "match_s_suffix" =
let rule =
{| where true
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -418,7 +363,7 @@ let%expect_test "configuration_choice_based_on_case" =
| "ame" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -437,7 +382,7 @@ let%expect_test "configuration_choice_based_on_case" =
| "names" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -474,7 +419,7 @@ let%expect_test "configuration_choice_based_on_case" =
| "names" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -495,7 +440,7 @@ let%expect_test "match_using_environment_merge" =
let rule =
{| where match :[1] { | "{ :[x] : :[y] }" -> :[x] == :[y] }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -530,7 +475,7 @@ let%expect_test "match_using_environment_merge" =
let rule =
{| where match :[1] { | "{ :[x] : :[y] }" -> :[x] == :[y] }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -555,7 +500,7 @@ let%expect_test "nested_matches" =
}
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -596,7 +541,7 @@ let%expect_test "nested_matches" =
}
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -617,7 +562,7 @@ let%expect_test "match_on_template" =
| "poodles" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -654,7 +599,7 @@ let%expect_test "match_on_template" =
| "poodles" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -691,7 +636,7 @@ let%expect_test "match_on_template" =
| "poodle" -> true
}
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in

2
test/common/test_nested_matches_alpha.ml
View File

@ -16,7 +16,7 @@ let run
match rule with
| None -> true
| Some rule ->
let options = Rule.create rule |> Or_error.ok_exn |> Rule.options in
let options = create rule |> Or_error.ok_exn |> Rule.options in
options.nested
in
M.all ~configuration ~nested ~template:match_template ~source ()

2
test/common/test_nested_matches_omega.ml
View File

@ -16,7 +16,7 @@ let run
match rule with
| None -> true
| Some rule ->
let options = Rule.create rule |> Or_error.ok_exn |> Rule.options in
let options = create rule |> Or_error.ok_exn |> Rule.options in
options.nested
in
M.all ~configuration ~nested ~template:match_template ~source ()

1
test/common/test_omega.ml
View File

@ -1,4 +1,5 @@
open Language
include Matchers.Omega
let create = Language.Rule.create
module Rule = Rule.Omega

196
test/common/test_parse_rule.ml Normal file
View File

@ -0,0 +1,196 @@
open Core
open Language
let rule_parses rule =
match Rule.create rule with
| Ok _ -> "true"
| Error _ -> "false"
let%expect_test "parse_rule" =
let rule = {| where :[1] == :[2], :[3] == "y" |} in
rule_parses rule |> print_string;
[%expect_exact {|true|}];
let rule = {| where :[1] == :[2], :[3] != "x" |} in
rule_parses rule |> print_string;
[%expect_exact {|true|}];
let rule = {| where :[1] != :[3] |} in
rule_parses rule |> print_string;
[%expect_exact {|true|}];
let rule = {| where :[1] != :[3], |} in
rule_parses rule |> print_string;
[%expect_exact {|true|}]
let%expect_test "parse_basic" =
Rule.create {|where "a" == "a"|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact {|(rule ((Equal (String a) (String a))))
|}]
let%expect_test "parse_option_nested" =
Rule.create {|where nested, "a" == "a" |}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact {|(rule ((Option nested) (Equal (String a) (String a))))
|}]
let%expect_test "parse_match_one_case" =
Rule.create {|where match "match_me" { | "case_one" -> true }|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule ((Match (String match_me) (((String case_one) (True))))))
"]
let%expect_test "parse_match_multi_case" =
Rule.create
{| where
match "match_me" {
| "case_one" -> true
| "case_two" -> false
}
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule
((Match (String match_me)
(((String case_one) (True)) ((String case_two) (False))))))
"]
let%expect_test "parse_case_optional_trailing" =
Rule.create
{| where
match "match_me" {
| "case_one" -> true,
| "case_two" -> false
}
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule
((Match (String match_me)
(((String case_one) (True)) ((String case_two) (False))))))
"]
let%expect_test "parse_case_optional_trailing" =
Rule.create
{| where
match "match_me" {
| "case_one" -> true,
| "case_two" -> false
}
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule
((Match (String match_me)
(((String case_one) (True)) ((String case_two) (False))))))
"]
let%expect_test "parse_freeform_antecedent_pattern" =
Rule.create
{| where
match "match_me" {
| case one -> true,
| case two -> false
| :[template] :[example] -> false
}
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule
((Match (String match_me)
(((String \"case one\") (True)) ((String \"case two\") (False))
((String \":[template] :[example]\") (False))))))
"]
let%expect_test "optional_first_pipe_one_case" =
Rule.create
{|
where match "match_me" { thing -> true, }
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule ((Match (String match_me) (((String thing) (True))))))
"]
let%expect_test "optional_first_pipe_multiple_cases" =
Rule.create
{|
where match "match_me" { thing -> true, | other -> true }
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule
((Match (String match_me) (((String thing) (True)) ((String other) (True))))))
"]
let%expect_test "parse_freeform_antecedent_pattern_single_quote" =
Rule.create
{|
where match "match_me" {
'"ni\'ce"' -> true
| `multi
line
` -> true
}
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule
((Match (String match_me)
(((String \"\\\"ni\\\\'ce\\\"\") (True)) ((String \"multi\\
\\nline\\
\\n\") (True))))))
"]
let%expect_test "parse_freeform_antecedent_pattern_map_regex" =
Rule.create
{| where
match "match_me" {
| ~match_me -> true,
| _ -> false,
}
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule
((Match (String match_me)
(((Variable :[~match_me]) (True)) ((Variable :[_]) (False))))))
"]
let%expect_test "parse_regex_hole" =
Rule.create
{|
where match :[1] {
| ":[~^\\d+$]" -> false
| ":[_]" -> true
}
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule
((Match (Variable 1)
(((String \":[~^\\\\d+$]\") (False)) ((String :[_]) (True))))))
"]
let%expect_test "parse_interpreting_escapes" =
Rule.create
{| where
match "match_me" {
| "\n\\" -> true,
| `a\n\heh
b` -> false,
}
|}
|> Or_error.ok_exn
|> fun rule -> print_s [%message (rule : Ast.expression list)];
[%expect_exact "(rule
((Match (String match_me)
(((String \"\\
\\n\\\\\") (True)) ((String \"a\\\\n\\\\heh\\
\\nb\") (False))))))
"]

32
test/common/test_rewrite_rule_alpha.ml
View File

@ -34,7 +34,7 @@ let%expect_test "rewrite_rule" =
{|
where rewrite :[1] { "int" -> "expect" }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -52,7 +52,7 @@ let%expect_test "sequenced_rewrite_rule" =
rewrite :[a] { "a" -> "qqq" },
rewrite :[rest] { "{ b : { :[other] } }" -> "{ :[other] }" }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -68,7 +68,7 @@ let%expect_test "rewrite_rule_for_list" =
{|
where rewrite :[contents] { ":[[x]]," -> ":[[x]];" }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -84,7 +84,7 @@ let%expect_test "rewrite_rule_for_list_strip_last" =
{|
where rewrite :[contents] { ":[x], " -> ":[x]; " }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -105,7 +105,7 @@ let%expect_test "haskell_example" =
{|
where rewrite :[contents] { "," -> "++" }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -115,3 +115,25 @@ let%expect_test "haskell_example" =
++ "blah"
)
|}]
let%expect_test "rewrite_freeform_antecedent_pattern" =
let source = {|
(concat
[ "blah blah blah"
, "blah"
])
|} in
let match_template = {|:[contents]|} in
let rewrite_template = {|(:[contents])|} in
let rule =
{|
where rewrite :[contents] { concat [:[x]] -> "nice" }
|}
|> create
|> Or_error.ok_exn
in
run_rule source match_template rewrite_template rule;
[%expect_exact {|(
(nice)
)|}]

32
test/common/test_rewrite_rule_omega.ml
View File

@ -34,7 +34,7 @@ let%expect_test "rewrite_rule" =
{|
where rewrite :[1] { "int" -> "expect" }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -52,7 +52,7 @@ let%expect_test "sequenced_rewrite_rule" =
rewrite :[a] { "a" -> "qqq" },
rewrite :[rest] { "{ b : { :[other] } }" -> "{ :[other] }" }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -68,7 +68,7 @@ let%expect_test "rewrite_rule_for_list" =
{|
where rewrite :[contents] { ":[[x]]," -> ":[[x]];" }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -84,7 +84,7 @@ let%expect_test "rewrite_rule_for_list_strip_last" =
{|
where rewrite :[contents] { ":[x], " -> ":[x]; " }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -105,7 +105,7 @@ let%expect_test "haskell_example" =
{|
where rewrite :[contents] { "," -> "++" }
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
@ -115,3 +115,25 @@ let%expect_test "haskell_example" =
++ "blah"
)
|}]
let%expect_test "rewrite_freeform_antecedent_pattern" =
let source = {|
(concat
[ "blah blah blah"
, "blah"
])
|} in
let match_template = {|:[contents]|} in
let rewrite_template = {|(:[contents])|} in
let rule =
{|
where rewrite :[contents] { concat [:[x]] -> "nice" }
|}
|> create
|> Or_error.ok_exn
in
run_rule source match_template rewrite_template rule;
[%expect_exact {|(
(nice)
)|}]

101
test/common/test_script.ml Normal file
View File

@ -0,0 +1,101 @@
let run input =
let result =
match Language.Script.parse input with
| Ok result -> Language.Script.to_string result
| Error _ -> "ERROR"
in
print_string result
let%expect_test "test_script_basic_sequence" =
let script = {|:[x] -> :[y] where nested---|} in
run script;
[%expect_exact {|((Spec
((match_template "(Variable x)") (rule (((Option nested))))
(rewrite_template ("(Variable y)")))))|}];
let script = {|:[x] -> :[y] where nested --- |} in
run script;
[%expect_exact {|((Spec
((match_template "(Variable x)") (rule (((Option nested))))
(rewrite_template ("(Variable y)")))))|}];
let script = {|:[x] -> :[y] where nested|} in
run script;
[%expect_exact {|((Spec
((match_template "(Variable x)") (rule (((Option nested))))
(rewrite_template ("(Variable y)")))))|}];
let script = {|
:[x] -> :[y] where nested ---
:[x] -> :[y] where nested
|}
in
run script;
[%expect_exact {|((Spec
((match_template "(Variable x)") (rule (((Option nested))))
(rewrite_template ("(Variable y)"))))
(Spec
((match_template "(Variable x)") (rule (((Option nested))))
(rewrite_template ("(Variable y)")))))|}]
let%expect_test "test_script_optional_rewrite" =
let script = {|:[x] where nested|} in
run script;
[%expect_exact {|((Spec
((match_template "(Variable x)") (rule (((Option nested))))
(rewrite_template ()))))|}];
let script = {|:[x] where nested--- :[y] where nested|} in
run script;
[%expect_exact {|((Spec
((match_template "(Variable x)") (rule (((Option nested))))
(rewrite_template ())))
(Spec
((match_template "(Variable y)") (rule (((Option nested))))
(rewrite_template ()))))|}]
let%expect_test "test_script_optional_rule" =
let script = {|:[x]|} in
run script;
[%expect_exact {|((Spec ((match_template "(Variable x)") (rule ()) (rewrite_template ()))))|}];
let script = {|:[x]--- :[y]--- :[z] -> :[q]|} in
run script;
[%expect_exact {|((Spec ((match_template "(Variable x)") (rule ()) (rewrite_template ())))
(Spec ((match_template "(Variable y)") (rule ()) (rewrite_template ())))
(Spec
((match_template "(Variable z)") (rule ())
(rewrite_template ("(Variable q)")))))|}]
let%expect_test "test_spec_expressions" =
let script = {|:[x] -> :[y] where nested or :[y] -> :[t] where nested---|} in
run script;
[%expect_exact {|((Exp Or
((Spec
((match_template "(Variable x)") (rule (((Option nested))))
(rewrite_template ("(Variable y)"))))
(Spec
((match_template "(Variable y)") (rule (((Option nested))))
(rewrite_template ("(Variable t)")))))))|}];
let script = {|
---
:[x] where nested or :[y] -> :[t] where nested
---
not :[x] and :[y] or :[z]
|} in
run script;
[%expect_exact {|((Exp Or
((Spec
((match_template "(Variable x)") (rule (((Option nested))))
(rewrite_template ())))
(Spec
((match_template "(Variable y)") (rule (((Option nested))))
(rewrite_template ("(Variable t)"))))))
(Exp Or
((Exp And
((Exp Not
((Spec
((match_template "(Variable x)") (rule ()) (rewrite_template ())))))
(Spec ((match_template "(Variable y)") (rule ()) (rewrite_template ())))))
(Spec ((match_template "(Variable z)") (rule ()) (rewrite_template ()))))))|}]

2
test/common/test_statistics.ml
View File

@ -28,7 +28,7 @@ let %expect_test "statistics" =
let rule =
{| where true
|}
|> Rule.create
|> create
|> Or_error.ok_exn
in
Go.all ~configuration ~template ~source ()