From ef5d42073971d6a3d2bad0bdca02b823d6323d54 Mon Sep 17 00:00:00 2001
From: Rijnard van Tonder <rvantonder@gmail.com>
Date: Sun, 6 Jun 2021 19:56:02 -0700
Subject: [PATCH] map aliases in rules

---
 lib/kernel/matchers/preprocess.ml | 22 ++++++++++++++++++++++
 lib/kernel/matchers/script.ml     |  2 +-
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/lib/kernel/matchers/preprocess.ml b/lib/kernel/matchers/preprocess.ml
index 74faab2..84f3ed0 100644
--- a/lib/kernel/matchers/preprocess.ml
+++ b/lib/kernel/matchers/preprocess.ml
@@ -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')
diff --git a/lib/kernel/matchers/script.ml b/lib/kernel/matchers/script.ml
index 5153818..58b8b9b 100644
--- a/lib/kernel/matchers/script.ml
+++ b/lib/kernel/matchers/script.ml
@@ -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 ->