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

map aliases in rules

Browse Source
This commit is contained in:
Rijnard van Tonder 2021-06-06 19:56:02 -07:00
parent 0a29179410
commit ef5d420739
2 changed files with 23 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lib/kernel/matchers/preprocess.ml
View File

@ -26,6 +26,17 @@ let map_template (module Parser : Types.Rule.S) template pattern match_template
let rule' = append_rule (module Parser) rule parent_rule in
template', rule'
let rec map_atom (rule : Types.Ast.expression list) f =
let open Types.Ast in
List.map rule ~f:(function
| Equal (l, r) -> Equal (f l, f r)
| Not_equal (l, r) -> Not_equal (f l, f r)
| Match (e, l) ->
Match (f e, List.map l ~f:(fun (a, l) -> (f a, map_atom l f)))
| Rewrite (e, (l, r)) ->
Rewrite (f e, (f l, f r))
| t -> t)
let map_aliases
(module Metasyntax : Metasyntax.S)
(module External : External.S)
@ -40,4 +51,15 @@ let map_aliases
| None -> template, parent_rule
| Some _ -> map_template (module Parser) template pattern match_template rule parent_rule
in
let parent_rule' =
let open Option in
parent_rule' >>| fun parent_rule' ->
map_atom parent_rule' (function
| Template t ->
Template (Parser.Template.parse
(String.substr_replace_all
(Parser.Template.to_string t) ~pattern ~with_:match_template))
| String s ->
String (String.substr_replace_all s ~pattern ~with_:match_template))
in
template', parent_rule')

2
lib/kernel/matchers/script.ml
View File

@ -49,7 +49,7 @@ module Make (Metasyntax : Types.Metasyntax.S) (External : Types.External.S) = st
let match_rewrite_parser =
both
(spaces *> template_parser (spaces *> string "->"))
(option None (spaces *> string Syntax.arrow *> spaces *> template_parser (spaces1 *> string "where" *> spaces1) >>| fun v -> Some v)) (* FIXME use of reserved *)
(option None (spaces *> string Syntax.arrow *> spaces *> template_parser (spaces1 *> string "where" *> spaces1) >>| fun v -> Some v))
in
match_rewrite_parser >>= fun (match_template_atom, rewrite_template_atom) ->
(option None (spaces1 *> Parser.parse >>| fun x -> Some x)) >>= fun rule ->