Remove the sound-X rules with a separate rewrite pass

Author: pavpanchekha

src/core/egg-herbie.rkt

@@ -287,11 +287,6 @@
       [`(Explanation ,body ...) `(Explanation ,@(map (lambda (e) (loop e type)) body))]
       [(list 'Rewrite=> rule expr) (list 'Rewrite=> (get-canon-rule-name rule rule) (loop expr type))]
       [(list 'Rewrite<= rule expr) (list 'Rewrite<= (get-canon-rule-name rule rule) (loop expr type))]
-      [(list op args ...)
-       #:when (string-prefix? (symbol->string op) "sound-")
-       (define op* (string->symbol (substring (symbol->string (car expr)) (string-length "sound-"))))
-       (define args* (drop-right args 1))
-       (cons op* (map loop args* (map (const 'real) args*)))]
       [(list op args ...)
        ;; Unfortunately the type parameter doesn't tell us much because mixed exprs exist
        ;; so if we see something like (and a b) we literally don't know which "and" it is

src/core/patch.rkt

@@ -90,7 +90,9 @@
   approxs*)
 
 (define (run-lowering altns global-batch)
-  (define schedule `((lower . ((iteration . 1) (scheduler . simple)))))
+  (define schedule
+    `((,(*sound-removal-rules*) . ((iteration . 1) (scheduler . simple)))
+      (lower . ((iteration . 1) (scheduler . simple)))))
 
   ; run egg
   (define brfs (map alt-expr altns))
@@ -160,10 +162,11 @@
   ; generate required rules
   (define rules (*rules*))
 
-  ; egg schedule (3-phases for mathematical rewrites and implementation selection)
+  ; egg schedule (4-phases for mathematical rewrites, sound-X removal, and implementation selection)
   (define schedule
     (list `(lift . ((iteration . 1) (scheduler . simple)))
           `(,rules . ((node . ,(*node-limit*))))
+          `(,(*sound-removal-rules*) . ((iteration . 1) (scheduler . simple)))
           `(lower . ((iteration . 1) (scheduler . simple)))))
 
   (define brfs (map alt-expr altns))

src/core/rules.rkt

@@ -6,6 +6,7 @@
          "../syntax/syntax.rkt")
 
 (provide *rules*
+         *sound-removal-rules*
          (struct-out rule)
          add-sound)
 
@@ -612,3 +613,9 @@
   [cosh-atanh-rev (/ 1 (sqrt (- 1 (* x x)))) (cosh (atanh x))]
   [asinh-2 (acosh (+ (* 2 (* x x)) 1)) (* 2 (asinh (fabs x)))]
   [acosh-2-rev (* 2 (acosh x)) (acosh (- (* 2 (* x x)) 1))])
+
+; Sound-X removal rules: run these before lowering
+(define (*sound-removal-rules*)
+  (list (rule 'remove-sound-/ '(sound-/ a b fallback) '(/ a b) '(sound-removal))
+        (rule 'remove-sound-pow '(sound-pow a b fallback) '(pow a b) '(sound-removal))
+        (rule 'remove-sound-log '(sound-log a fallback) '(log a) '(sound-removal))))