mirror of
https://github.com/comby-tools/comby.git
synced 2024-08-16 16:50:37 +03:00
abstract matchers and rules over fresh variable generator (#270)
This commit is contained in:
parent
110dbe6f16
commit
84a76e1dc7
@ -154,12 +154,16 @@ module Matchers : sig
|
||||
|
||||
- [match_newline_toplevel] determines whether matching should terminate
|
||||
on newlines if a hole is not specified inside a recognized block syntax.
|
||||
Default: [false]. *)
|
||||
Default: [false].
|
||||
|
||||
- [fresh] is a generator for fresh values, used to evaluate equality
|
||||
relations. *)
|
||||
val create
|
||||
: ?disable_substring_matching:bool
|
||||
-> ?match_kind:match_kind
|
||||
-> ?significant_whitespace:bool
|
||||
-> ?match_newline_toplevel:bool
|
||||
-> ?fresh:(unit -> string)
|
||||
-> unit
|
||||
-> t
|
||||
end
|
||||
@ -461,12 +465,15 @@ module Rule : sig
|
||||
(** [create] parses and creates a rule. *)
|
||||
val create : string -> t Or_error.t
|
||||
|
||||
(** [apply matcher substitute_in_place rule env] applies a [rule] according to
|
||||
some [matcher] for existing matches in [env]. If [substitute_in_place] is
|
||||
true, rewrite rules substitute their values in place (default true). *)
|
||||
(** [apply matcher substitute_in_place fresh rule env] applies a [rule]
|
||||
according to some [matcher] for existing matches in [env]. If
|
||||
[substitute_in_place] is true, rewrite rules substitute their values in
|
||||
place (default true). [fresh] introduces fresh variables for evaluating
|
||||
rules. *)
|
||||
val apply
|
||||
: ?matcher:(module Matchers.Matcher.S)
|
||||
-> ?substitute_in_place:bool
|
||||
-> ?fresh:(unit -> string)
|
||||
-> t
|
||||
-> Match.environment
|
||||
-> result
|
||||
|
@ -39,9 +39,16 @@ let merge_match_environments matches environment' =
|
||||
type rewrite_context =
|
||||
{ variable : string }
|
||||
|
||||
let counter =
|
||||
let uuid_for_id_counter = ref 0 in
|
||||
fun () ->
|
||||
uuid_for_id_counter := !uuid_for_id_counter + 1;
|
||||
Format.sprintf "gu3ssme_%012d" !uuid_for_id_counter
|
||||
|
||||
let rec apply
|
||||
?(matcher = (module Matchers.Alpha.Generic : Matchers.Matcher.S))
|
||||
?(substitute_in_place = true)
|
||||
?(fresh = counter)
|
||||
predicates
|
||||
env =
|
||||
let open Option in
|
||||
@ -104,7 +111,7 @@ let rec apply
|
||||
Option.value_map result ~f:ident ~default:(false, Some env)
|
||||
| Match (String template, cases) ->
|
||||
let source, _ = Rewriter.Rewrite_template.substitute template env in
|
||||
let fresh_var = Uuid_unix.(Fn.compose Uuid.to_string create ()) in
|
||||
let fresh_var = fresh () in
|
||||
let env = Environment.add env fresh_var source in
|
||||
rule_match env (Match (Variable fresh_var, cases))
|
||||
| RewriteTemplate rewrite_template ->
|
||||
|
@ -41,9 +41,16 @@ let merge_match_environments matches environment' =
|
||||
type rewrite_context =
|
||||
{ variable : string }
|
||||
|
||||
let counter =
|
||||
let uuid_for_id_counter = ref 0 in
|
||||
fun () ->
|
||||
uuid_for_id_counter := !uuid_for_id_counter + 1;
|
||||
Format.sprintf "gu3ssme_%012d" !uuid_for_id_counter
|
||||
|
||||
let rec apply
|
||||
?(matcher = (module Matchers.Omega.Generic : Matchers.Matcher.S))
|
||||
?(substitute_in_place = true)
|
||||
?(fresh = counter)
|
||||
predicates
|
||||
env =
|
||||
let open Option in
|
||||
@ -106,7 +113,7 @@ let rec apply
|
||||
Option.value_map result ~f:ident ~default:(false, Some env)
|
||||
| Match (String template, cases) ->
|
||||
let source, _ = Rewriter.Rewrite_template.substitute template env in
|
||||
let fresh_var = Uuid_unix.(Fn.compose Uuid.to_string create ()) in
|
||||
let fresh_var = fresh () in
|
||||
let env = Environment.add env fresh_var source in
|
||||
rule_match env (Match (Variable fresh_var, cases))
|
||||
| RewriteTemplate rewrite_template ->
|
||||
|
@ -21,6 +21,7 @@ module type Engine = sig
|
||||
val apply
|
||||
: ?matcher:(module Matcher.S)
|
||||
-> ?substitute_in_place:bool
|
||||
-> ?fresh:(unit -> string)
|
||||
-> t
|
||||
-> environment
|
||||
-> result
|
||||
|
@ -370,7 +370,7 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct
|
||||
let environment =
|
||||
if Environment.exists environment identifier && String.(identifier <> "_") then
|
||||
let fresh_hole_id =
|
||||
Format.sprintf "%s_%s_equal" Uuid_unix.(Fn.compose Uuid.to_string create ()) identifier
|
||||
Format.sprintf "%s_%s_equal" (!configuration_ref.fresh ()) identifier
|
||||
in
|
||||
Environment.add ~range environment fresh_hole_id (String.concat matched)
|
||||
else
|
||||
|
@ -7,16 +7,25 @@ type t =
|
||||
; significant_whitespace : bool
|
||||
; disable_substring_matching : bool
|
||||
; match_newline_toplevel : bool
|
||||
; fresh : unit -> string
|
||||
}
|
||||
|
||||
let counter =
|
||||
let uuid_for_id_counter = ref 0 in
|
||||
fun () ->
|
||||
uuid_for_id_counter := !uuid_for_id_counter + 1;
|
||||
Format.sprintf "!@#$%012d" !uuid_for_id_counter
|
||||
|
||||
let create
|
||||
?(disable_substring_matching = false)
|
||||
?(match_kind = Fuzzy)
|
||||
?(significant_whitespace = false)
|
||||
?(match_newline_toplevel = true)
|
||||
?(fresh = counter)
|
||||
() =
|
||||
{ match_kind
|
||||
; significant_whitespace
|
||||
; disable_substring_matching
|
||||
; match_newline_toplevel
|
||||
; fresh
|
||||
}
|
||||
|
@ -7,6 +7,7 @@ type t =
|
||||
; significant_whitespace : bool
|
||||
; disable_substring_matching : bool
|
||||
; match_newline_toplevel : bool
|
||||
; fresh : unit -> string
|
||||
}
|
||||
|
||||
val create
|
||||
@ -14,5 +15,6 @@ val create
|
||||
-> ?match_kind:match_kind
|
||||
-> ?significant_whitespace:bool
|
||||
-> ?match_newline_toplevel:bool
|
||||
-> ?fresh:(unit -> string)
|
||||
-> unit
|
||||
-> t
|
||||
|
@ -95,7 +95,7 @@ let record_match_context pos_before pos_after =
|
||||
if rewrite then Buffer.add_string actual result;
|
||||
matches_ref := match_context :: !matches_ref
|
||||
|
||||
module Make (Language : Language.S) (_ : Metasyntax.S) = struct
|
||||
module Make (Language : Language.S) (Unimplemented : Metasyntax.S) = struct
|
||||
include Language.Info
|
||||
module Syntax = Language.Syntax
|
||||
|
||||
@ -133,11 +133,10 @@ module Make (Language : Language.S) (_ : Metasyntax.S) = struct
|
||||
let range = { match_start = before; match_end = after } in
|
||||
let add identifier = Environment.add ~range !current_environment_ref identifier content in
|
||||
let environment =
|
||||
match Environment.exists !current_environment_ref identifier with
|
||||
match Environment.exists !current_environment_ref identifier && String.(identifier <> "_") with
|
||||
| true ->
|
||||
(* FIXME: get rid of UUID *)
|
||||
let fresh_hole_id =
|
||||
Format.sprintf "%s_%s_equal" Uuid_unix.(Fn.compose Uuid.to_string create ()) identifier
|
||||
Format.sprintf "%s_%s_equal" (!configuration_ref.fresh ()) identifier
|
||||
in
|
||||
add fresh_hole_id
|
||||
| false -> add identifier
|
||||
|
@ -37,7 +37,8 @@ let apply_rule ?(substitute_in_place = true) matcher omega rule matches =
|
||||
else
|
||||
Rule.Alpha.apply
|
||||
in
|
||||
let sat, env = apply ~substitute_in_place ~matcher rule environment in
|
||||
let fresh () = Uuid_unix.(Fn.compose Uuid.to_string create ()) in
|
||||
let sat, env = apply ~fresh ~substitute_in_place ~matcher rule environment in
|
||||
(if sat then env else None)
|
||||
>>| fun environment -> { matched with environment })
|
||||
|
||||
@ -282,20 +283,21 @@ let run
|
||||
; metasyntax
|
||||
}
|
||||
=
|
||||
let fresh = match compute_mode with
|
||||
| `Sequential -> None
|
||||
| _ -> Some (fun () -> Uuid_unix.(Fn.compose Uuid.to_string create ()))
|
||||
in
|
||||
|
||||
let match_configuration =
|
||||
Matchers.Configuration.create
|
||||
~disable_substring_matching
|
||||
~match_kind:Fuzzy
|
||||
~match_newline_toplevel
|
||||
?fresh
|
||||
()
|
||||
in
|
||||
let start_time = Statistics.Time.start () in
|
||||
|
||||
let fresh = match compute_mode with
|
||||
| `Sequential -> None
|
||||
| _ -> Some (fun () -> Uuid_unix.(Fn.compose Uuid.to_string create ()))
|
||||
in
|
||||
|
||||
let per_unit ~(input : single_source) ~output_path =
|
||||
run_on_specifications
|
||||
specifications
|
||||
|
@ -7,7 +7,6 @@ let debug =
|
||||
Sys.getenv "DEBUG_COMBY"
|
||||
|> Option.is_some
|
||||
|
||||
|
||||
let substitute_match_contexts ?fresh ?metasyntax (matches: Match.t list) source replacements =
|
||||
if debug then Format.printf "Matches: %d | Replacements: %d@." (List.length matches) (List.length replacements);
|
||||
let rewrite_template, environment =
|
||||
|
Loading…
Reference in New Issue
Block a user