Merge pull request #1337 from herbie-fp/codex/locate-itypes-and-otype-usages

Simplify rule struct by dropping type info

Author: pavpanchekha

src/core/egg-herbie.rkt

@@ -464,16 +464,13 @@
   (cond
     [(symbol? input)
      ; expansive rules
-     (define itype (dict-ref (rule-itypes ru) input))
      (for/list ([op (all-operators)]
-                #:when (eq? (operator-info op 'otype) itype))
+                #:when (eq? (operator-info op 'otype) 'real))
        (define itypes (operator-info op 'itype))
        (define vars (map (lambda (_) (gensym)) itypes))
        (rule (sym-append (rule-name ru) '-expand- op)
              (cons op vars)
              (replace-expression (rule-output ru) input (cons op vars))
-             (map cons vars itypes)
-             (rule-otype ru)
              (rule-tags ru)))]
     ; non-expansive rule
     [else (list (rule->egg-rule ru))]))

src/core/egglog-herbie.rkt

@@ -609,15 +609,10 @@
 (define (egglog-rewrite-rules rules tag)
   (for/list ([rule (in-list rules)]
              #:when (not (symbol? (rule-input rule))))
-    (if (not (representation? (rule-otype rule)))
-        `(rewrite ,(expr->e1-pattern (rule-input rule))
-                  ,(expr->e1-pattern (rule-output rule))
-                  :ruleset
-                  ,tag)
-        `(rewrite ,(expr->e2-pattern (rule-input rule) (rule-otype rule))
-                  ,(expr->e2-pattern (rule-output rule) (rule-otype rule))
-                  :ruleset
-                  ,tag))))
+    `(rewrite ,(expr->e1-pattern (rule-input rule))
+              ,(expr->e1-pattern (rule-output rule))
+              :ruleset
+              ,tag)))
 
 (define (egglog-add-exprs batch ctx curr-program)
   (define mappings (build-vector (batch-length batch) values))

src/core/rules.rkt

@@ -12,7 +12,7 @@
 
 ;; A rule represents "find-and-replacing" `input` by `output`. Both
 ;; are patterns, meaning that symbols represent pattern variables.
-(struct rule (name input output itypes otype tags)
+(struct rule (name input output tags)
   #:methods gen:custom-write
   [(define (write-proc rule port mode)
      (fprintf port "#<rule ~a>" (rule-name rule)))])
@@ -31,16 +31,6 @@
 (define (*sound-rules*)
   (filter (conjoin rule-enabled? rule-sound?) *all-rules*))
 
-; An analog of free-variables due to cycles in loading
-(define (get-input-variables prog)
-  (match prog
-    [(? number?) '()]
-    [(? symbol?) (list prog)]
-    [(list _ args ...) (remove-duplicates (append-map get-input-variables args))]))
-
-(define (make-rule-context input output)
-  (map (curryr cons 'real) (set-union (get-input-variables input) (get-input-variables output))))
-
 (define (add-unsound expr)
   (match expr
     [(list op args ...) (cons (sym-append "unsound-" op) (map add-unsound args))]
@@ -49,15 +39,9 @@
 (define-syntax define-rule
   (syntax-rules ()
     [(define-rule rname group input output)
-     (set! *all-rules*
-           (cons (rule 'rname 'input 'output (make-rule-context 'input 'output) 'real '(group sound))
-                 *all-rules*))]
+     (set! *all-rules* (cons (rule 'rname 'input 'output '(group sound)) *all-rules*))]
     [(define-rule rname group input output #:unsound)
-     (set!
-      *all-rules*
-      (cons
-       (rule 'rname 'input (add-unsound 'output) (make-rule-context 'input 'output) 'real '(group))
-       *all-rules*))]))
+     (set! *all-rules* (cons (rule 'rname 'input (add-unsound 'output) '(group)) *all-rules*))]))
 
 (define-syntax-rule (define-rules group
                       [rname input output flags ...] ...)

src/core/test-rules.rkt

@@ -29,7 +29,7 @@
     [_ expr]))
 
 (define (check-rule test-rule)
-  (match-define (rule name p1 p2 _ _ _) test-rule)
+  (match-define (rule name p1 p2 _) test-rule)
   (define ctx (env->ctx p1 p2))
 
   (match-define (list pts exs1 exs2)

src/syntax/platform.rkt

@@ -256,30 +256,23 @@
                (cons impl pform)
                (lambda ()
                  (define name (sym-append 'lift- impl))
-                 (define itypes (impl-info impl 'itype))
-                 (define otype (impl-info impl 'otype))
                  (define-values (vars spec-expr impl-expr) (impl->rule-parts impl))
-                 (rule name impl-expr spec-expr (map cons vars itypes) otype '(lifting))))))
+                 (rule name impl-expr spec-expr '(lifting))))))
 
 ;; Synthesizes lowering rules for a given platform.
 (define (platform-lowering-rules [pform (*active-platform*)])
   (define impls (platform-impls pform))
   (append* (for/list ([impl (in-list impls)])
-             (hash-ref!
-              (*lowering-rules*)
-              (cons impl pform)
-              (lambda ()
-                (define name (sym-append 'lower- impl))
-                (define-values (vars spec-expr impl-expr) (impl->rule-parts impl))
-                (define itypes (map representation-type (impl-info impl 'itype)))
-                (define otype (representation-type (impl-info impl 'otype)))
-                (list (rule name spec-expr impl-expr (map cons vars itypes) otype '(lowering))
-                      (rule (sym-append 'lower-unsound- impl)
-                            (add-unsound spec-expr)
-                            impl-expr
-                            (map cons vars itypes)
-                            otype
-                            '(lowering))))))))
+             (hash-ref! (*lowering-rules*)
+                        (cons impl pform)
+                        (lambda ()
+                          (define name (sym-append 'lower- impl))
+                          (define-values (vars spec-expr impl-expr) (impl->rule-parts impl))
+                          (list (rule name spec-expr impl-expr '(lowering))
+                                (rule (sym-append 'lower-unsound- impl)
+                                      (add-unsound spec-expr)
+                                      impl-expr
+                                      '(lowering))))))))
 
 ;; Extracts the `fpcore` field of an operator implementation
 ;; as a property dictionary and expression.