comby-tools/comby
1
1
Fork 0
mirror of https://github.com/comby-tools/comby.git synced 2024-08-16 16:50:37 +03:00
Code Issues Packages Projects Releases Wiki Activity

additional utility attributes (#289)

Browse Source
This commit is contained in:
Rijnard van Tonder 2021-05-21 00:15:34 -07:00 committed by GitHub
parent f0b37a99a2
commit ae45ff4e50
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
34 changed files with 383 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -404,7 +404,9 @@ module Printer = struct
in
let print_if_some output = Option.value_map output ~default:() ~f:(Format.fprintf ppf "%s@.") in
match output_format with
| Stdout -> Format.fprintf ppf "%s" rewritten_source
| Stdout ->
if not (String.equal "\n" rewritten_source) then (* FIXME: somehow newlines are entering here. *)
Format.fprintf ppf "%s" rewritten_source
| Overwrite_file ->
if (replacements <> []) then
Out_channel.write_all ~data:rewritten_source (Option.value path ~default:"/dev/null")
@ -733,10 +735,7 @@ let create
let open Or_error in
emit_errors configuration >>= fun () ->
emit_warnings configuration >>= fun () ->
let rule =
let rule = String.substr_replace_all rule ~pattern:"..." ~with_:":[_]" in
Matchers.Rule.create rule |> Or_error.ok_exn
in
let rule = Matchers.Rule.create rule |> Or_error.ok_exn in
let specifications =
match templates, anonymous_arguments with
| None, Some { match_template; rewrite_template; _ } ->
@ -748,11 +747,6 @@ let create
parse_templates ~warn_for_missing_file_in_dir:true templates
| _ -> assert false
in
let specifications =
List.map specifications ~f:(fun ({ match_template ; _ } as spec) ->
{ spec with match_template =
String.substr_replace_all match_template ~pattern:"..." ~with_:":[_]" })
in
let specifications =
if match_only then
List.map specifications ~f:(fun { match_template; rule; _ } ->

12
lib/app/pipeline/pipeline.ml
View File

@ -18,6 +18,7 @@ let debug =
let timed_run
(module Matcher : Matcher.S)
?(fast_offset_conversion = false)
?filepath
~configuration
~source
~specification:(Specification.{ match_template = template; rule; rewrite_template })
@ -25,7 +26,7 @@ let timed_run
(match rewrite_template with
| Some template -> Matcher.set_rewrite_template template;
| None -> ());
Matcher.all ?rule ~configuration ~template ~source ()
Matcher.all ~configuration ?filepath ?rule ~template ~source ()
|> List.map ~f:(Match.convert_offset ~fast:fast_offset_conversion ~source)
type output =
@ -57,12 +58,12 @@ let process_single_source
(Specification.{ rewrite_template; _ } as specification)
=
try
let input_text =
let filepath, input_text =
match source with
| String input_text -> input_text
| String input_text -> None, input_text
| Path path ->
if verbose then log_to_file path;
In_channel.read_all path
Some path, In_channel.read_all path
in
let matches =
with_timeout timeout source ~f:(fun () ->
@ -71,6 +72,7 @@ let process_single_source
~fast_offset_conversion
~configuration
~specification
?filepath
~source:input_text
())
in
@ -82,7 +84,7 @@ let process_single_source
(* If there are no matches, return the original source (for editor support). *)
Replacement ([], input_text, 0)
| matches ->
match Rewrite.all ~source:input_text ?metasyntax ?fresh ~rewrite_template matches with
match Rewrite.all ~source:input_text ?metasyntax ?fresh ?filepath ~rewrite_template matches with
| None -> Nothing
| Some { rewritten_source; in_place_substitutions } ->
Replacement (in_place_substitutions, rewritten_source, List.length matches)

24
lib/kernel/comby_kernel.mli
View File

@ -245,6 +245,12 @@ module Matchers : sig
Defines the metasyntax recognized in templates and associates the
metasyntax with the matching behavior of holes. *)
module Metasyntax : sig
(** aliases where a match of the string [pattern] maps to [match_template] and [rule]. *)
type alias =
{ pattern : string
; match_template : string
; rule : string option
}
(** A hole definition should comprise either a string prefix, suffix, or
both which encloses an variable identifier. See example below. *)
@ -284,6 +290,7 @@ module Matchers : sig
type t =
{ syntax : hole_syntax list
; identifier : string
; aliases : alias list
}
val to_yojson : t -> Yojson.Safe.json
@ -293,6 +300,7 @@ module Matchers : sig
module type S = sig
val syntax : hole_syntax list
val identifier : string
val aliases : alias list
end
(** A module representing the default metasyntax *)
@ -335,9 +343,10 @@ module Matchers : sig
type kind =
| Value
| Length
| Type
| LsifHover
| FileName
| FilePath
| FileDirectory
| Lowercase
| Uppercase
| Capitalize
@ -381,13 +390,6 @@ module Matchers : sig
type antecedent = atom
[@@deriving sexp]
type kind =
| Value
| Length
| Type
| File
[@@deriving sexp]
type expression =
| True
| False
@ -410,6 +412,7 @@ module Matchers : sig
recursively on matched content. *)
val all
: ?configuration:configuration
-> ?filepath:string
-> ?rule:Rule.t
-> template:string
-> source:string
@ -421,6 +424,7 @@ module Matchers : sig
val first
: ?configuration:configuration
-> ?shift:int
-> ?filepath:string
-> string
-> string
-> match' Core_kernel.Or_error.t
@ -468,8 +472,10 @@ module Matchers : sig
val apply :
?substitute_in_place:bool ->
?metasyntax:Metasyntax.t ->
?filepath:string ->
match_all:(
?configuration:Configuration.t ->
?filepath:string ->
template:string ->
source:string ->
unit ->
@ -739,6 +745,7 @@ module Matchers : sig
: ?source:string
-> ?metasyntax:metasyntax
-> ?fresh:(unit -> string)
-> ?filepath:string
-> rewrite_template:string
-> match' list
-> replacement option
@ -756,6 +763,7 @@ module Matchers : sig
val substitute
: ?metasyntax:metasyntax
-> ?fresh:(unit -> string)
-> ?filepath:string
-> string
-> Match.environment
-> string

1
lib/kernel/match/match.ml
View File

@ -1,6 +1,7 @@
module Location = Location
module Range = Range
module Environment = Environment
module Offset = Offset
include Types
include Match_context

12
lib/kernel/match/match.mli
View File

@ -57,6 +57,18 @@ end
type environment = Environment.t
[@@deriving yojson]
module Offset : sig
type index_t
val empty : index_t
val index : source:string -> index_t
val convert_fast : offset:int -> index_t -> int * int
val convert_slow : offset:int -> source:string -> int * int
end
type t =
{ range : range
; environment : environment

13
lib/kernel/matchers/alpha.ml
View File

@ -946,8 +946,9 @@ module Make (Lang : Types.Language.S) (Meta : Metasyntax.S) = struct
Ok result
| Failed (msg, _) -> Or_error.error_string msg
let first ?configuration ?shift template source =
let first ?configuration ?shift ?filepath template source =
let open Or_error in
let _ : string option = filepath in
configuration_ref := Option.value configuration ~default:!configuration_ref;
to_template template >>= fun p ->
let shift =
@ -957,8 +958,11 @@ module Make (Lang : Types.Language.S) (Meta : Metasyntax.S) = struct
in
first' shift p source
let all ?configuration ?(rule = [Types.Ast.True]) ~template ~source:original_source () : Match.t list =
let all ?configuration ?filepath ?(rule = [Types.Ast.True]) ~template ~source:original_source () : Match.t list =
let _ : string option = filepath in
let Rule.{ nested } = Rule.options rule in
let template, rule = Preprocess.map_aliases template (Some rule) Meta.aliases in
let rule = Option.value_exn rule in (* OK in this case *)
let rec aux_all ?configuration ?(nested = false) ~template ~source:original_source () =
let open Or_error in
depth := (-1);
@ -991,7 +995,7 @@ module Make (Lang : Types.Language.S) (Meta : Metasyntax.S) = struct
let result =
if debug then Format.printf "Rule: %s@." (Sexp.to_string @@ Rule.sexp_of_t rule);
(* FIXME metasyntax should propagate *)
let sat, env = Program.apply ~metasyntax:Metasyntax.default_metasyntax ~substitute_in_place:true rule environment in
let sat, env = Program.apply ~metasyntax:Metasyntax.default_metasyntax ~substitute_in_place:true ?filepath rule environment in
if debug && Option.is_some env then Format.printf "Got back: %b %S" sat (Match.Environment.to_string @@ Option.value_exn env);
let new_env = if sat then env else None in
match new_env with
@ -1086,6 +1090,7 @@ module Make (Lang : Types.Language.S) (Meta : Metasyntax.S) = struct
val apply
: ?substitute_in_place:bool
-> ?metasyntax:Types.Metasyntax.t
-> ?filepath:string
-> Rule.t
-> Match.environment
-> Evaluate.result
@ -1094,11 +1099,13 @@ module Make (Lang : Types.Language.S) (Meta : Metasyntax.S) = struct
let apply
?(substitute_in_place = true)
?metasyntax
?filepath
rule
env =
Evaluate.apply
~substitute_in_place
?metasyntax
?filepath
~match_all:(Matcher.all ~rule:[Types.Ast.True])
rule
env

2
lib/kernel/matchers/dune
View File

@ -3,4 +3,4 @@
(public_name comby-kernel.matchers)
(instrumentation (backend bisect_ppx))
(preprocess (pps ppx_here ppx_sexp_conv ppx_sexp_message ppx_deriving_yojson))
(libraries comby-kernel.replacement comby-kernel.parsers comby-kernel.match comby.vangstrom core_kernel mparser mparser-pcre re yojson ppx_deriving_yojson))
(libraries comby-semantic comby-kernel.replacement comby-kernel.parsers comby-kernel.match comby.vangstrom core_kernel mparser mparser-pcre re yojson ppx_deriving_yojson))

26
lib/kernel/matchers/evaluate.ml
View File

@ -31,14 +31,16 @@ let merge_match_environments matches environment' =
(* FIXME. Propagate this. *)
module Template = Template.Make(Metasyntax.Default)
let substitute env = function
| Template t -> Rewrite.substitute (Template.to_string t) env
let substitute ?filepath env v =
match v with
| Template t -> Rewrite.substitute ?filepath (Template.to_string t) env
| String s -> s
let apply
?(substitute_in_place = true)
?metasyntax
~(match_all:(?configuration:Configuration.t -> template:string -> source:string -> unit -> Match.t list))
?filepath
~(match_all:(?configuration:Configuration.t -> ?filepath:string -> template:string -> source:string -> unit -> Match.t list))
predicates
env =
@ -54,15 +56,15 @@ let apply
(* ==, != *)
| Equal (Template t, String value)
| Equal (String value, Template t) ->
let other = Rewrite.substitute (Template.to_string t) env in
let other = Rewrite.substitute ?filepath (Template.to_string t) env in
let result = String.equal value other in
result, Some env
| Equal (String left, String right) ->
let result = String.equal left right in
result, Some env
| Equal (Template left, Template right) ->
let left = Rewrite.substitute (Template.to_string left) env in
let right = Rewrite.substitute (Template.to_string right) env in
let left = Rewrite.substitute ?filepath (Template.to_string left) env in
let right = Rewrite.substitute ?filepath (Template.to_string right) env in
let result = String.equal left right in
result, Some env
| Not_equal (left, right) ->
@ -71,9 +73,9 @@ let apply
(* match ... { ... } *)
| Match (source, cases) ->
let source = substitute env source in
let source = substitute ?filepath env source in
let evaluate template case_expression =
let template = substitute env template in
let template = substitute ?filepath env template in
let configuration = match_configuration_of_syntax template in
if debug then Format.printf "Running for template %s source %s@." template source;
match_all ~configuration ~template ~source () |> function
@ -100,9 +102,9 @@ let apply
(* rewrite ... { ... } *)
| Rewrite (Template t, (match_template, rewrite_template)) ->
let rewrite_template = substitute env rewrite_template in
let template = substitute env match_template in
let source = Rewrite.substitute (Template.to_string t) env in
let rewrite_template = substitute ?filepath env rewrite_template in
let template = substitute ?filepath env match_template in
let source = Rewrite.substitute ?filepath (Template.to_string t) env in
let configuration = Configuration.create ~match_kind:Fuzzy () in
let matches = match_all ~configuration ~template ~source () in
let source = if substitute_in_place then Some source else None in
@ -112,7 +114,7 @@ let apply
else
let Replacement.{ rewritten_source; _ } = Option.value_exn result in
(* substitute for variables that are in the outside scope *)
let rewritten_source = Rewrite.substitute ?metasyntax rewritten_source env in
let rewritten_source = Rewrite.substitute ?filepath ?metasyntax rewritten_source env in
let variable =
match t with
| [ Types.Template.Hole { variable; _ } ] -> variable

11
lib/kernel/matchers/metasyntax.ml
View File

@ -15,15 +15,24 @@ let default_syntax =
let default_identifier =
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
let default_aliases =
[ { pattern = "..."
; match_template = ":[_]"
; rule = None
}
]
let default_metasyntax =
{ syntax = default_syntax
; identifier = default_identifier
; aliases = default_aliases
}
let create { syntax; identifier } =
let create { syntax; identifier; aliases } =
let module Metasyntax = struct
let syntax = syntax
let identifier = identifier
let aliases = aliases
end
in
(module Metasyntax : Types.Metasyntax.S)

20
lib/kernel/matchers/omega.ml
View File

@ -30,6 +30,8 @@ let push_environment_ref : Match.Environment.t ref = ref (Match.Environment.crea
let push_matches_ref : Match.t list ref = ref []
let push_source_ref : string ref = ref ""
let filepath_ref : string option ref = ref None
let debug =
match Sys.getenv "DEBUG_COMBY" with
| exception Not_found -> false
@ -97,8 +99,7 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) = struct
let open Range in
let acc = f acc production in
match production with
| String s ->
if debug then Format.printf "Saw String: %S@." s;
| String _ ->
return (Unit, acc)
| Match { offset = pos_begin; identifier; text = content } ->
(* Inefficiency: a Match production happens even for hole parsers in 'rest'. It's difficult to
@ -168,6 +169,7 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) = struct
Program.apply
~metasyntax:Metasyntax.default_metasyntax
~substitute_in_place:true
?filepath:!filepath_ref
rule
!current_environment_ref
in
@ -1007,14 +1009,16 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) = struct
in
Match.create ~range ()
let all ?configuration ?(rule = [Types.Ast.True]) ~template ~source:original_source () : Match.t list =
let all ?configuration ?filepath ?(rule = [Types.Ast.True]) ~template ~source:original_source () : Match.t list =
filepath_ref := filepath;
push_matches_ref := !matches_ref;
configuration_ref := Option.value configuration ~default:!configuration_ref;
let Rule.{ nested } = Rule.options rule in
let template, rule = Preprocess.map_aliases template (Some rule) Meta.aliases in
let rec aux_all ?configuration ?(nested = false) ~template ~source () =
matches_ref := [];
if String.is_empty template && String.is_empty source then [trivial]
else match first_is_broken template source (Some rule) with
else match first_is_broken template source rule with
| Ok _
| Error _ ->
let matches = List.rev !matches_ref in
@ -1084,10 +1088,11 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) = struct
matches_ref := !push_matches_ref;
result
let first ?configuration ?shift:_ template source : Match.t Or_error.t =
let first ?configuration ?shift:_ ?filepath template source : Match.t Or_error.t =
filepath_ref := filepath;
configuration_ref := Option.value configuration ~default:!configuration_ref;
matches_ref := [];
match all ?configuration ~template ~source () with
match all ?filepath ?configuration ~template ~source () with
| [] -> Or_error.error_string "No result"
| (hd::_) -> Ok hd (* FIXME be efficient *)
end
@ -1096,6 +1101,7 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) = struct
val apply
: ?substitute_in_place:bool
-> ?metasyntax:Metasyntax.t
-> ?filepath:string
-> Rule.t
-> Match.environment
-> Evaluate.result
@ -1103,11 +1109,13 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) = struct
let apply
?(substitute_in_place = true)
?metasyntax
?filepath
rule
env =
Evaluate.apply
~substitute_in_place
?metasyntax
?filepath
~match_all:(Matcher.all ~rule:[Types.Ast.True])
rule
env

32
lib/kernel/matchers/preprocess.ml Normal file
View File

@ -0,0 +1,32 @@
open Core_kernel
let debug =
match Sys.getenv "DEBUG_COMBY" with
| exception Not_found -> false
| _ -> true
let map_aliases template parent_rule aliases =
List.fold aliases
~init:(template, parent_rule)
~f:(fun (template, parent_rule) Types.Metasyntax.{ pattern; match_template; rule } ->
let open Option in
match String.substr_index template ~pattern with
| None -> template, parent_rule
| Some _ ->
let template' = String.substr_replace_all template ~pattern ~with_:match_template in
if debug then Format.printf "Substituted: %s@." template';
let rule' =
let rule =
rule
>>| Rule.Parser.create
>>| function
| Ok rule -> rule
| Error e -> failwith @@ "Could not parse rule for alias entry:"^(Error.to_string_hum e)
in
match parent_rule, rule with
| Some parent_rule, Some rule -> Some (parent_rule @ rule)
| None, Some rule -> Some rule
| Some parent_rule, None -> Some parent_rule
| None, None -> None
in
template', rule')

11
lib/kernel/matchers/rewrite.ml
View File

@ -76,13 +76,14 @@ let substitute_fresh
let substitute_in_rewrite_template
?fresh
?(metasyntax = Metasyntax.default_metasyntax)
?filepath
template
environment =
let (module M) = Metasyntax.create metasyntax in
let module Template_parser = Template.Make(M) in
let template = substitute_fresh ~metasyntax ?fresh template in
let terms = Template_parser.parse template in
let replacement_content, environment = Template_parser.substitute terms environment in
let replacement_content, environment = Template_parser.substitute ?filepath terms environment in
{ replacement_content
; environment
; range =
@ -91,8 +92,8 @@ let substitute_in_rewrite_template
}
}
let substitute ?(metasyntax = Metasyntax.default_metasyntax) ?fresh template env =
let { replacement_content; _ } = substitute_in_rewrite_template ?fresh ~metasyntax template env
let substitute ?(metasyntax = Metasyntax.default_metasyntax) ?fresh ?filepath template env =
let { replacement_content; _ } = substitute_in_rewrite_template ?fresh ?filepath ~metasyntax template env
in replacement_content
let substitute_matches (matches: Match.t list) source replacements =
@ -114,13 +115,13 @@ let substitute_matches (matches: Match.t list) source replacements =
; in_place_substitutions
}
let all ?source ?metasyntax ?fresh ~rewrite_template rev_matches : result option =
let all ?source ?metasyntax ?fresh ?filepath ~rewrite_template rev_matches : result option =
Option.some_if (not (List.is_empty rev_matches)) @@
match source with
(* in-place substitution *)
| Some source ->
rev_matches
|> List.map ~f:(fun Match.{ environment; _ } -> substitute_in_rewrite_template ?metasyntax ?fresh rewrite_template environment)
|> List.map ~f:(fun Match.{ environment; _ } -> substitute_in_rewrite_template ?filepath ?metasyntax ?fresh rewrite_template environment)
|> substitute_matches rev_matches source
(* no in place substitution, emit result separated by newlines *)
| None ->

3
lib/kernel/matchers/rewrite.mli
View File

@ -7,7 +7,7 @@ open Match
val substitute_fresh : ?metasyntax:Metasyntax.t -> ?fresh:(unit -> string) -> string -> string
(** substitute returns the result of substituting env in template *)
val substitute : ?metasyntax:Metasyntax.t -> ?fresh:(unit -> string) -> string -> Environment.t -> string
val substitute : ?metasyntax:Metasyntax.t -> ?fresh:(unit -> string) -> ?filepath:string -> string -> Environment.t -> string
(** if [source] is given, substitute in-place. If not,
emit result separated by newlines *)
@ -15,6 +15,7 @@ val all
: ?source:string
-> ?metasyntax:Types.Metasyntax.t
-> ?fresh:(unit -> string)
-> ?filepath:string
-> rewrite_template:string
-> Match.t list
-> Replacement.result option

52
lib/kernel/matchers/template.ml
View File

@ -4,6 +4,11 @@ open Core_kernel
open Match
open Types.Template
let debug =
match Sys.getenv "DEBUG_COMBY" with
| exception Not_found -> false
| _ -> true
module Make (Metasyntax : Types.Metasyntax.S) = struct
let up_to p =
@ -73,9 +78,10 @@ module Make (Metasyntax : Types.Metasyntax.S) = struct
let attribute_to_kind = function
| "value" -> Value
| "length" -> Length
| "type" -> Type
| "file.name" -> FileName
| "lsif.hover" -> LsifHover
| "file.path" -> FilePath
| "file.name" -> FileName
| "file.directory" -> FileDirectory
| "lowercase" -> Lowercase
| "UPPERCASE" -> Uppercase
| "Capitalize" -> Capitalize
@ -90,11 +96,10 @@ module Make (Metasyntax : Types.Metasyntax.S) = struct
char '.' *> choice
[ string "value"
; string "length"
; string "type"
(*
; string "file.name"
; string "lsif.hover"
; string "file.path"
*)
; string "file.name"
; string "file.directory"
; string "lowercase"
; string "UPPERCASE"
; string "Capitalize"
@ -181,15 +186,38 @@ module Make (Metasyntax : Types.Metasyntax.S) = struct
aux 0 (String.to_list s)
|> String.of_char_list
let substitute_kind { variable; kind; _ } env =
let substitute_kind ?filepath { variable; kind; _ } env =
let open Option in
let length_to_string n = Format.sprintf "%d" (String.length n) in
match kind with
| Value -> Environment.lookup env variable
| Length -> Environment.lookup env variable >>| length_to_string
| Type -> failwith "unimplemented"
| FileName -> failwith "unimplemented"
| FilePath -> failwith "unimplemented"
| LsifHover ->
filepath >>= fun filepath ->
if debug then Format.printf "File for lsif.hover lookup: %s@." filepath;
Environment.lookup env variable >>= fun value ->
Environment.lookup_range env variable
>>= fun { match_start = { offset; _ }; _ } ->
if debug then Format.printf "Var offset is %d@." offset;
let source = In_channel.read_all filepath in (* Inefficient. *)
if debug then Format.printf "Read filepath, source len is %d@." @@ String.length source;
String.chop_prefix_if_exists filepath ~prefix:(Sys.getcwd ()) |> fun filepath_relative_root ->
if debug then Format.printf "File relative root: %s@." filepath;
let index = Match.Offset.index ~source in
let line, column = Match.Offset.convert_fast ~offset index in
let line, column = line - 1, column - 1 + String.length value - 1 in
if debug then Format.printf "Querying type at %d::%d@." line column;
let context =
Comby_semantic.Lsif.Context.
{ repository = "github.com/sourcegraph/sourcegraph"
; lsif_endpoint = "https://sourcegraph.com/.api/graphql"
; formatting = Markdown ("```go", "```") (* Expose. *)
}
in
Comby_semantic.Lsif.hover_at context ~filepath:filepath_relative_root ~line ~column
| FilePath -> filepath
| FileName -> filepath >>| Filename.basename
| FileDirectory -> filepath >>| Filename.dirname
| Lowercase ->
Environment.lookup env variable
>>| String.lowercase
@ -223,12 +251,12 @@ module Make (Metasyntax : Types.Metasyntax.S) = struct
>>| camel_to_snake
>>| String.lowercase
let substitute template environment =
let substitute ?filepath template environment =
let replacement_content, environment', _ =
List.fold template ~init:([], Environment.create (), 0) ~f:(fun (result, env, pos) -> function
| Constant c -> c::result, env, pos + String.length c
| Hole ({ variable; pattern; _ } as h) ->
match substitute_kind h environment with
match substitute_kind ?filepath h environment with
| None -> pattern::result, env, pos + String.length variable
| Some value ->
let advance = pos + String.length value in

2
lib/kernel/matchers/template.mli
View File

@ -12,5 +12,5 @@ module Make : Metasyntax.S -> sig
val to_string : t -> string
val substitute : t -> Match.Environment.t -> (string * Match.Environment.t)
val substitute : ?filepath:string -> t -> Match.Environment.t -> (string * Match.Environment.t)
end

20
lib/kernel/matchers/types.ml
View File

@ -85,6 +85,12 @@ end
type hole = Hole.t
module Metasyntax = struct
type alias =
{ pattern : string
; match_template : string
; rule : string option
}
[@@deriving yojson]
type hole_definition =
| Delimited of string option * string option
@ -99,12 +105,14 @@ module Metasyntax = struct
type t =
{ syntax : hole_syntax list
; identifier : string
; aliases : alias list
}
[@@deriving yojson]
module type S = sig
val syntax : hole_syntax list
val identifier : string
val aliases : alias list
end
end
@ -117,9 +125,10 @@ module Template = struct
type kind =
| Value
| Length
| Type
| LsifHover
| FileName
| FilePath
| FileDirectory
| Lowercase
| Uppercase
| Capitalize
@ -156,13 +165,6 @@ module Ast = struct
type antecedent = atom
[@@deriving sexp]
type kind = (* FIXME holes needs to have associated substitution kind *)
| Value
| Length
| Type
| File
[@@deriving sexp]
type expression =
| True
| False
@ -184,6 +186,7 @@ module Matcher = struct
module type S = sig
val all
: ?configuration:Configuration.t
-> ?filepath:string
-> ?rule:Rule.t
-> template:string
-> source:string
@ -193,6 +196,7 @@ module Matcher = struct
val first
: ?configuration:Configuration.t
-> ?shift:int
-> ?filepath:string
-> string
-> string
-> Match.t Or_error.t

5
lib/semantic/README.md Normal file
View File

@ -0,0 +1,5 @@
```
curl 'https://sourcegraph.com/.api/graphql' \
--data-raw $'{"query":"query Hover($repository: String\u0021, $commit: String\u0021, $path: String\u0021, $line: Int\u0021, $character: Int\u0021) {\\n repository(name: $repository) {\\n commit(rev: $commit) {\\n blob(path: $path) {\\n lsif {\\n hover(line: $line, character: $character) {\\n markdown {\\n text\\n }\\n range {\\n start {\\n line\\n character\\n }\\n end {\\n line\\n character\\n }\\n }\\n }\\n }\\n }\\n }\\n }\\n}","variables":{"line":10,"character":30,"commit":"HEAD","path":"lib/codeintel/semantic/hash.go","repository":"github.com/sourcegraph/sourcegraph"},"operationName":"Hover"}' \
--compressed
```

11
lib/semantic/dune Normal file
View File

@ -0,0 +1,11 @@
(library
(name comby_semantic)
(public_name comby-semantic)
(instrumentation (backend bisect_ppx))
(preprocess (pps ppx_deriving.show ppx_deriving.eq ppx_sexp_conv))
(libraries
core_kernel
lwt
cohttp
cohttp-lwt-unix
yojson))

82
lib/semantic/lsif.ml Normal file
View File

@ -0,0 +1,82 @@
open Core_kernel
open Lwt
open Cohttp
open Cohttp_lwt_unix
let debug =
match Sys.getenv "DEBUG_COMBY" with
| exception Not_found -> false
| _ -> true
module Formatting = struct
type t =
| Markdown of string * string
| Text
let hover format text =
match format with
| Text -> text
| Markdown (start, stop) ->
let lines = text |> String.split_lines |> List.rev in
let rec aux acc collect = function
| [] -> acc
| hd::_ when String.is_prefix hd ~prefix:start ->
acc
| hd::tl when String.is_prefix hd ~prefix:stop ->
aux acc true tl
| hd::tl when collect ->
aux (hd::acc) collect tl
| _::tl ->
aux acc collect tl
in
aux [] false lines |> String.concat ~sep:"\n"
end
module Context = struct
type t =
{ lsif_endpoint : string
; repository : string
; formatting : Formatting.t
}
end
let body Context.{ repository; lsif_endpoint; _ } filepath line character =
let query = {|{"query":"query Hover($repository: String!, $commit: String!, $path: String!, $line: Int!, $character: Int!) {\n repository(name: $repository) {\n commit(rev: $commit) {\n blob(path: $path) {\n lsif {\n hover(line: $line, character: $character) {\n markdown {\n text\n }\n range {\n start {\n line\n character\n }\n end {\n line\n character\n }\n }\n }\n }\n }\n }\n }\n}"|} in
let variables =
Format.sprintf
{|"variables":{"line":%d,"character":%d,"commit":"HEAD","path":"%s","repository":"%s"},"operationName":"Hover"}|}
line
character
filepath
repository
in
let request = Format.sprintf {|%s,%s|} query variables in
Lwt_unix.sleep 0.25 >>= fun _ ->
Client.post ~body:(Cohttp_lwt.Body.of_string request) (Uri.of_string lsif_endpoint) >>= fun (resp, body) ->
let code = resp |> Response.status |> Code.code_of_status in
if debug then Printf.printf "Response code: %d\n" code;
body |> Cohttp_lwt.Body.to_string
(** {"data":{"repository":{"commit":{"blob":{"lsif":{"hover":{"markdown":{"text":"```go\nvar tr *Trace\n```"},"range":{"start":{"line":64,"character":1},"end":{"line":64,"character":3}}}}}}}}} *)
let hover_at context ~filepath ~line ~column =
let body =
Lwt_main.run (body context filepath line column) in
try
let response = Yojson.Safe.from_string body in
if debug then Format.printf "Response: %s@." @@ Yojson.Safe.pretty_to_string response;
let text =
response
|> Yojson.Safe.to_basic
|> Yojson.Basic.Util.member "data"
|> Yojson.Basic.Util.member "repository"
|> Yojson.Basic.Util.member "commit"
|> Yojson.Basic.Util.member "blob"
|> Yojson.Basic.Util.member "lsif"
|> Yojson.Basic.Util.member "hover"
|> Yojson.Basic.Util.member "markdown"
|> Yojson.Basic.Util.member "text"
|> Yojson.Basic.Util.to_string
|> Formatting.hover context.formatting
in
Some text
with _ -> None

15
lib/semantic/lsif.mli Normal file
View File

@ -0,0 +1,15 @@
module Formatting : sig
type t =
| Markdown of string * string
| Text
end
module Context : sig
type t =
{ lsif_endpoint : string
; repository : string
; formatting : Formatting.t
}
end
val hover_at : Context.t -> filepath:string -> line:int -> column:int -> string option

2
test/common/test_cli.ml
View File

@ -778,7 +778,7 @@ let%expect_test "newline_separated_output"=
let match_template = ":[[1]]" in
let rewrite_template = ":[[1]]" in
let command_args =
Format.sprintf "-stdin -sequential -stdout '%s' '%s' -n -matcher .generic"
Format.sprintf "-stdin -sequential -stdout '%s' '%s' -matcher .generic -newline-separated"
match_template rewrite_template
in
let command = Format.sprintf "%s %s" binary_path command_args in

41
test/common/test_custom_metasyntax.ml
View File

@ -6,7 +6,7 @@ open Test_helpers
let configuration = Matchers.Configuration.create ~match_kind:Fuzzy ()
let create (module E : Matchers.Engine.S) syntax =
let metasyntax = Matchers.Metasyntax.{ syntax; identifier = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_" } in
let metasyntax = Matchers.Metasyntax.{ syntax; identifier = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_"; aliases = [] } in
Option.value_exn (E.select_with_extension ~metasyntax ".go")
let%expect_test "custom_metasyntax_everything" =
@ -188,7 +188,7 @@ let%expect_test "custom_metasyntax_rewrite_alpha" =
; Hole (Alphanum, Delimited (Some "?", None))
]
in
let metasyntax = Matchers.Metasyntax.{ syntax; identifier = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_" } in
let metasyntax = Matchers.Metasyntax.{ syntax; identifier = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_"; aliases = [] } in
let matcher = Option.value_exn (Matchers.Alpha.select_with_extension ~metasyntax ".go") in
let specification = Matchers.Specification.create ~match_template:"$A(?B)" ~rewrite_template:"??B -> $A$A" () in
@ -218,7 +218,7 @@ let%expect_test "custom_metasyntax_rewrite_omega" =
; Hole (Alphanum, Delimited (Some "?", None))
]
in
let metasyntax = Matchers.Metasyntax.{ syntax; identifier = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_" } in
let metasyntax = Matchers.Metasyntax.{ syntax; identifier = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_"; aliases = [] } in
let matcher = Option.value_exn (Matchers.Omega.select_with_extension ~metasyntax ".go") in
let specification = Matchers.Specification.create ~match_template:"$A(?B)" ~rewrite_template:"??B -> $A$A" () in
@ -278,9 +278,42 @@ let%expect_test "custom_metasyntax_rewrite_length" =
]
in
let metasyntax = Matchers.Metasyntax.{ syntax; identifier = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_" } in
let metasyntax = Matchers.Metasyntax.{ syntax; identifier = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_"; aliases = [] } in
run ~metasyntax (create (module Matchers.Alpha) syntax) "simple(bar)" {|[:A:](α)|} {|[:A:].length (α.length)|};
[%expect_exact {|6 (3)|}];
run ~metasyntax (create (module Matchers.Omega) syntax) "simple(bar)" {|[:A:](α)|} {|[:A:].length (α.length)|};
[%expect_exact {|6 (3)|}]
let%expect_test "custom_metasyntax_test_alias" =
let aliases =
Matchers.Metasyntax.
[ { pattern = "_1"
; match_template = ":[x1]"
; rule = Some "where :[x1].length == '1'"
}
; { pattern = "_2"
; match_template = ":[x2]"
; rule = Some "where :[x2].length == '2'"
}
; { pattern = "_3"
; match_template = ":[x3]"
; rule = Some "where :[x3].length == '3'"
}
]
in
(* Need to use default metasyntax because rules don't yet support arbitrary metasyntax *)
let metasyntax = { Matchers.Metasyntax.default_metasyntax with aliases } in
let alpha = Option.value_exn (Matchers.Alpha.select_with_extension ~metasyntax ".go") in
let omega = Option.value_exn (Matchers.Omega.select_with_extension ~metasyntax ".go") in
run ~metasyntax alpha "foo(a) foo(ab) foo(abc) foo(abcd)" "foo(_2)" "matched";
[%expect_exact {|foo(a) matched foo(abc) foo(abcd)|}];
run ~metasyntax omega "foo(a) foo(ab) foo(abc) foo(abcd)" "foo(_2)" "matched";
[%expect_exact {|foo(a) matched foo(abc) foo(abcd)|}];
run ~metasyntax alpha "foo(a) foo(ab) foo(abc) foo(abcd)" "foo(_3)" "matched";
[%expect_exact {|foo(a) foo(ab) matched foo(abcd)|}];
run ~metasyntax omega "foo(a) foo(ab) foo(abc) foo(abcd)" "foo(_3)" "matched";
[%expect_exact {|foo(a) foo(ab) matched foo(abcd)|}]

6
test/common/test_helpers.ml
View File

@ -27,17 +27,17 @@ let print_only_match matches =
|> Yojson.Safe.pretty_to_string
|> print_string
let run ?(configuration = configuration) ?metasyntax (module M : Matchers.Matcher.S) source match_template ?rule rewrite_template =
let run ?(configuration = configuration) ?filepath ?metasyntax (module M : Matchers.Matcher.S) source match_template ?rule rewrite_template =
let rule =
match rule with
| Some rule -> Matchers.Rule.create rule |> Or_error.ok_exn
| None -> Rule.create "where true" |> Or_error.ok_exn
in
M.all ~rule ~configuration ~template:match_template ~source ()
M.all ?filepath ~rule ~configuration ~template:match_template ~source ()
|> function
| [] -> print_string "No matches."
| results ->
Option.value_exn (Rewrite.all ?metasyntax ~source ~rewrite_template results)
Option.value_exn (Rewrite.all ?metasyntax ?filepath ~source ~rewrite_template results)
|> (fun { rewritten_source; _ } -> rewritten_source)
|> print_string

6
test/common/test_parse_template.ml
View File

@ -43,6 +43,7 @@ let%expect_test "interpret_incomplete_hole_as_constant_metasyntax" =
; Regex ("$", ':', " ")
]
; identifier = "AB"
; aliases = []
}
in
parse_template metasyntax template |> print_string;
@ -59,6 +60,7 @@ let%expect_test "interpret_incomplete_hole_as_constant_metasyntax" =
; Hole (Everything, Reserved_identifiers [" "; " "])
]
; identifier = "AB"
; aliases = []
}
in
parse_template metasyntax template |> print_string;
@ -77,6 +79,7 @@ let%expect_test "interpret_incomplete_hole_as_constant_metasyntax" =
; Hole (Everything, Reserved_identifiers [".."; "."])
]
; identifier = "AB"
; aliases = []
}
in
parse_template metasyntax template |> print_string;
@ -92,6 +95,7 @@ let%expect_test "parse_reserved_identifiers_as_holes" =
[ Hole (Expression, Reserved_identifiers ["α"])
]
; identifier = "AB"
; aliases = []
}
in
parse_template metasyntax template |> print_string;
@ -107,7 +111,7 @@ let%expect_test "get_offsets_for_holes" =
print_s [%message (variables : Matchers.Template.syntax list)];
[%expect {|
(variables
(((variable a) (pattern :[a].type) (offset 0) (kind Type))
(((variable a) (pattern :[a]) (offset 0) (kind Value))
((variable b) (pattern :[b].length) (offset 10) (kind Length))
((variable c) (pattern :[[c]]) (offset 22) (kind Value))
((variable d) (pattern :[d.].length) (offset 37) (kind Length))

26
test/common/test_rewrite_attributes.ml
View File

@ -45,4 +45,28 @@ let%expect_test "strings" =
lowerCamelCase
UPPER_SNAKE_CASE
lower_snake_case
|}];
|}]
let%expect_test "filepath_rewrite_template" =
let source = {|whatever|} in
let filepath = "this/is/a/path" in
run (module Matchers.Alpha.Generic) ~filepath source ":[all]" "\n:[all].file.path\n:[all].file.name\n:[all].file.directory";
[%expect_exact {|
this/is/a/path
path
this/is/a|}];
run (module Matchers.Omega.Generic) ~filepath source ":[all]" "\n:[all].file.path\n:[all].file.name\n:[all].file.directory";
[%expect_exact {|
this/is/a/path
path
this/is/a|}]
let%expect_test "filepath_rule" =
let source = {|thing|} in
let filepath = "this/is/a/path" in
let match_template = ":[x]" in
let rule = {|where rewrite :[x] { _ -> :[x].file.path }|} in
run (module Matchers.Alpha.Generic) ~filepath source ~rule match_template "ok: :[x]";
[%expect_exact {|ok: this/is/a/path|}];
run (module Matchers.Omega.Generic) ~filepath source ~rule match_template "ok: :[x]";
[%expect_exact {|ok: this/is/a/path|}]

1
test/common/test_substitute.ml
View File

@ -13,6 +13,7 @@ let%expect_test "substitute_entire_regex_pattern_in_custom_metasyntax" =
; Regex ("$", ':', " ")
]
; identifier = "AB"
; aliases = []
}
in
(* Don't just substitute for `$B`, but for `$B:\w+ `. This depends on Regex (more specific syntax) being defined _after_ the general syntax. *)

3
test/example/metasyntax/dangling.json
View File

@ -4,7 +4,8 @@
[ "Hole", [ "Expression" ], [ "Delimited", "))", null ] ]
],
"identifier":
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",
"aliases": []
}
// echo 'swap(x, y)' | \
// ./comby -stdin -custom-metasyntax test/example/metasyntax/dangling.json \

3
test/example/metasyntax/default.json
View File

@ -29,5 +29,6 @@
[ "Regex", ":[", "~", "]" ]
],
"identifier":
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",
"aliases": [ { "pattern": "...", "match_template": ":[_]", "rule": null } ]
}

3
test/example/metasyntax/dolla.json
View File

@ -4,5 +4,6 @@
[ "Regex", "$", "~", "$" ] // order is significant!
],
"identifier":
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",
"aliases": []
}

3
test/example/metasyntax/emoji.json
View File

@ -13,7 +13,8 @@
]
],
"identifier":
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",
"aliases": []
}
// echo 'swap(x, y)' | \
// ./comby -stdin -custom-metasyntax test/example/metasyntax/emoji.json \

3
test/example/metasyntax/inverted-parens.json
View File

@ -4,7 +4,8 @@
[ "Hole", [ "Expression" ], [ "Delimited", "))", "((" ] ]
],
"identifier":
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",
"aliases": []
}
// echo 'swap(x, y)' | \
// ./comby -stdin -custom-metasyntax test/example/metasyntax/inverted-parens.json \

3
test/example/metasyntax/lambda.json
View File

@ -17,7 +17,8 @@
]
],
"identifier":
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",
"aliases": []
}
// echo 'swap(x, y)' | \
// ./comby -stdin -custom-metasyntax test/example/metasyntax/lambda.json \

3
test/example/metasyntax/test.json
View File

@ -4,5 +4,6 @@
[ "Hole", [ "Alphanum" ], [ "Delimited", "?", null ] ]
],
"identifier":
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",
"aliases": []
}

3
test/example/metasyntax/wutspace.json
View File

@ -10,7 +10,8 @@
]
],
"identifier":
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",
"aliases": []
}
// echo 'swap(x,y)' | \
// ./comby -stdin -custom-metasyntax test/example/metasyntax/wutspace.json \