mirror of
https://github.com/comby-tools/comby.git
synced 2024-09-11 13:25:36 +03:00
support reserved identifiers for variables (#274)
This commit is contained in:
parent
5304b31189
commit
98df3f795d
@ -268,7 +268,8 @@ module Matchers : sig
|
||||
(** A hole definition should comprise either a string prefix, suffix, or
|
||||
both which encloses an variable identifier. See example below. *)
|
||||
type hole_definition =
|
||||
Delimited of string option * string option
|
||||
| Delimited of string option * string option
|
||||
| Reserved_identifiers of string list
|
||||
|
||||
(** Defines syntax definitions for holes. Zero or more Hole sorts, excluding
|
||||
[Regex] should have an associated [hole_definition]. The [Regex] hole
|
||||
|
@ -268,7 +268,8 @@ module Matchers : sig
|
||||
(** A hole definition should comprise either a string prefix, suffix, or
|
||||
both which encloses an variable identifier. See example below. *)
|
||||
type hole_definition =
|
||||
Delimited of string option * string option
|
||||
| Delimited of string option * string option
|
||||
| Reserved_identifiers of string list
|
||||
|
||||
(** Defines syntax definitions for holes. Zero or more Hole sorts, excluding
|
||||
[Regex] should have an associated [hole_definition]. The [Regex] hole
|
||||
|
@ -253,6 +253,8 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct
|
||||
List.fold ~init:[] Metasyntax.syntax ~f:(fun acc -> function
|
||||
| Hole (sort, Delimited (left, right)) ->
|
||||
(sort, (p left >> hole_body () << p right))::acc
|
||||
| Hole (sort, Reserved_identifiers l) ->
|
||||
(sort, choice (List.map ~f:(fun s -> string s |>> fun s -> (false, s)) l))::acc
|
||||
| Regex (left, separator, right) ->
|
||||
(Regex, (p (Some left) >> regex_body separator right () << p (Some right)))::acc)
|
||||
|
||||
@ -832,7 +834,7 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct
|
||||
let open Hole in
|
||||
let hole_parser =
|
||||
let open Polymorphic_compare in
|
||||
List.find_map hole_parsers ~f:(fun (sort', parser) -> Option.some_if (sort' = sort) parser)
|
||||
List.fold ~init:[] hole_parsers ~f:(fun acc (sort', parser) -> if sort' = sort then parser::acc else acc)
|
||||
in
|
||||
let skip_signal hole = skip (string "_signal_hole") |>> fun () -> Hole hole in
|
||||
let at_depth =
|
||||
@ -846,9 +848,10 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct
|
||||
| _ -> at_depth
|
||||
in
|
||||
match hole_parser with
|
||||
| None -> fail "none" (* not defined *)
|
||||
| Some p ->
|
||||
p |>> function (optional, identifier) -> skip_signal { sort; identifier; dimension; optional; at_depth }
|
||||
| [] -> fail "none" (* not defined *)
|
||||
| l ->
|
||||
choice l |>> function (optional, identifier) ->
|
||||
skip_signal { sort; identifier; dimension; optional; at_depth }
|
||||
|
||||
let generate_hole_for_literal dimension ~contents ~left_delimiter ~right_delimiter s =
|
||||
let holes = choice @@ List.map hole_parsers ~f:(fun (kind, _) -> attempt (hole_parser kind dimension)) in
|
||||
@ -863,8 +866,7 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct
|
||||
choice
|
||||
[ holes
|
||||
; (spaces1 |>> generate_pure_spaces_parser)
|
||||
; ((many1 (is_not (choice [reserved_holes; skip space] ))
|
||||
|>> String.of_char_list) |>> generate_string_token_parser)
|
||||
; ((many1 (is_not (choice [reserved_holes; skip space] )) |>> String.of_char_list) |>> generate_string_token_parser)
|
||||
]
|
||||
in
|
||||
match parse_string p contents (Match.create ()) with
|
||||
|
@ -1,5 +1,6 @@
|
||||
include Types.Metasyntax
|
||||
|
||||
(* Format.printf "%s@." @@ Matchers.Metasyntax.(json Matchers.Metasyntax.default_metasyntax);; *)
|
||||
let default_syntax =
|
||||
[ Hole (Everything, Delimited (Some ":[", Some "]"))
|
||||
; Hole (Expression, Delimited (Some ":[", Some ":e]"))
|
||||
@ -7,6 +8,8 @@ let default_syntax =
|
||||
; Hole (Non_space, Delimited (Some ":[", Some ".]"))
|
||||
; Hole (Line, Delimited (Some ":[", Some "\\n]"))
|
||||
; Hole (Blank, Delimited (Some ":[ ", Some "]"))
|
||||
; Hole (Expression, Reserved_identifiers ["α"; "β"; "γ"; "δ"; "ε"; "ζ"; "η"; "θ"; "ι"; "κ"; "λ"; "μ"; "ξ"; "π"; "ρ"; "ς"; "σ"; "τ"; "υ"; "φ"; "χ"; "ψ"; "ω"])
|
||||
; Hole (Everything, Reserved_identifiers ["Γ"; "Δ"; "Θ"; "Λ"; "Ξ"; "Π"; "Σ"; "Φ"; "Ψ"; "Ω"])
|
||||
; Regex (":[", '~', "]")
|
||||
]
|
||||
|
||||
|
@ -91,6 +91,7 @@ module Metasyntax = struct
|
||||
|
||||
type hole_definition =
|
||||
| Delimited of string option * string option
|
||||
| Reserved_identifiers of string list
|
||||
[@@deriving yojson]
|
||||
|
||||
type hole_syntax =
|
||||
|
@ -90,6 +90,8 @@ module Make (Metasyntax : Matchers.Metasyntax.S) = struct
|
||||
fun (o, v) ->
|
||||
Format.sprintf "%s%s%s%s" (Option.value left ~default:"") (if o then "?" else "") v (Option.value right ~default:""),
|
||||
v
|
||||
| Hole (_, Reserved_identifiers l) ->
|
||||
choice (List.map l ~f:string) >>| fun v -> v, v
|
||||
| Regex (left, separator, right) ->
|
||||
p (Some left) *> regex_body separator right <* p (Some right) >>|
|
||||
fun ((_, v), expr) ->
|
||||
|
@ -165,4 +165,25 @@ let%expect_test "custom_metasyntax_rewrite" =
|
||||
| Nothing -> "nothing"
|
||||
in
|
||||
print_string output;
|
||||
[%expect_exact {|1 2 2|}];
|
||||
[%expect_exact {|1 2 2|}]
|
||||
|
||||
let%expect_test "custom_metasyntax_greek_letters" =
|
||||
let matcher = create
|
||||
[ Hole (Alphanum, Reserved_identifiers ["α"; "β"])
|
||||
]
|
||||
in
|
||||
|
||||
run matcher "simple(bar)" {|α(β)|} "";
|
||||
[%expect_exact {|{"uri":null,"matches":[{"range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":11,"line":1,"column":12}},"environment":[{"variable":"α","value":"simple","range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":6,"line":1,"column":7}}},{"variable":"β","value":"bar","range":{"start":{"offset":7,"line":1,"column":8},"end":{"offset":10,"line":1,"column":11}}}],"matched":"simple(bar)"}]}
|
||||
|}]
|
||||
|
||||
let%expect_test "custom_metasyntax_alphanum_test" =
|
||||
let matcher = create
|
||||
[ Hole (Alphanum, Delimited (Some "[:", Some ":]"))
|
||||
; Hole (Alphanum, Reserved_identifiers ["α"; "β"])
|
||||
]
|
||||
in
|
||||
|
||||
run matcher "simple(bar)" {|[:A:](α)|} "";
|
||||
[%expect_exact {|{"uri":null,"matches":[{"range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":11,"line":1,"column":12}},"environment":[{"variable":"A","value":"simple","range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":6,"line":1,"column":7}}},{"variable":"α","value":"bar","range":{"start":{"offset":7,"line":1,"column":8},"end":{"offset":10,"line":1,"column":11}}}],"matched":"simple(bar)"}]}
|
||||
|}]
|
||||
|
@ -1253,3 +1253,14 @@ let%expect_test "test_custom_metasyntax_partial_rule_support" =
|
||||
let result = read_expect_stdin_and_stdout command source in
|
||||
print_string result;
|
||||
[%expect "a b"]
|
||||
|
||||
let%expect_test "test_custom_metasyntax_reserved_identifiers" =
|
||||
let source = "fun f -> (fun x -> f (x x)) (fun x -> f (x x))" in
|
||||
let metasyntax_path = "example" ^/ "metasyntax" ^/ "default.json" in
|
||||
let command_args =
|
||||
Format.sprintf {|'λ f -> α α' 'α' -stdin -custom-metasyntax %s -stdout|} metasyntax_path
|
||||
in
|
||||
let command = Format.sprintf "%s %s" binary_path command_args in
|
||||
let result = read_expect_stdin_and_stdout command source in
|
||||
print_string result;
|
||||
[%expect "(fun x -> f (x x))"]
|
||||
|
@ -6,6 +6,26 @@
|
||||
[ "Hole", [ "Non_space" ], [ "Delimited", ":[", ".]" ] ],
|
||||
[ "Hole", [ "Line" ], [ "Delimited", ":[", "\\n]" ] ],
|
||||
[ "Hole", [ "Blank" ], [ "Delimited", ":[ ", "]" ] ],
|
||||
[
|
||||
"Hole",
|
||||
[ "Expression" ],
|
||||
[
|
||||
"Reserved_identifiers",
|
||||
[
|
||||
"α", "β", "γ", "δ", "ε", "ζ", "η", "θ", "ι", "κ", "λ",
|
||||
"μ", "ξ", "π", "ρ", "ς", "σ", "τ", "υ", "φ", "χ", "ψ",
|
||||
"ω"
|
||||
]
|
||||
]
|
||||
],
|
||||
[
|
||||
"Hole",
|
||||
[ "Everything" ],
|
||||
[
|
||||
"Reserved_identifiers",
|
||||
[ "Γ", "Δ", "Θ", "Λ", "Ξ", "Π", "Σ", "Φ", "Ψ", "Ω" ]
|
||||
]
|
||||
],
|
||||
[ "Regex", ":[", "~", "]" ]
|
||||
],
|
||||
"identifier":
|
Loading…
Reference in New Issue
Block a user