Revision c3861f5c7371fea2fc5d20404a7f77c927bbd61b authored by Shuhei Kadowaki on 14 August 2021, 12:49:21 UTC, committed by Shuhei Kadowaki on 23 August 2021, 15:09:13 UTC
Built on top of #41882, this PR sorts out the constant-prop' interface
yet more, particularly generalizes `force_const_prop` to `const_prop_config`
so that it can turn on and off each heuristic.

The main motivation here is, in #41882, we want to force const-prop' on
`setproperty` even when its return type is already `Const` for the sake
of succeeding inlining, by skipping all the `const_prop_xxx_heuristic` checks.
But I still found we want to apply `const_prop_entry_heuristic` to
`getproperty`, because if we already know very accurate result for a
`getproperty` call, usually there is really no motivation for constant-prop', e.g.:
```julia
struct FZero end
Base.getproperty(::FZero, ::Symbol) = 0.0
getproperty(FZero(), :val) # const-prop' doesn't need to happen here
```

Now `force_const_prop(...) -> force::Bool` is refactored to
`const_prop_config(...) -> config::UInt8`, which can turn on and off
each heuristic based on the value of `config`.

I also included another refactoring that inlines `const_prop_rettype_heuristic`
into `const_prop_argument_heuristic`, because they really seem tightly coupled.
1 parent e1e4986
Raw File
utils.scm
;; for debugging, display x and return it
(define (prn x)
  (with-output-to *stderr*
                  (display x) (newline))
  x)

;; return the mapping for `elt` in `alst`, or `default` if not found
(define (lookup elt alst default)
  (let ((a (assq elt alst)))
    (if a (cdr a) default)))

;; items in `s1` and not in `s2`
(define (diff s1 s2)
  (cond ((null? s1)         '())
        ((memq (car s1) s2) (diff (cdr s1) s2))
        (else               (cons (car s1) (diff (cdr s1) s2)))))

(define (intersect s1 s2)
  (filter (lambda (x) (memq x s2)) s1))

(define (has-dups lst)
  (if (null? lst)
      #f
      (or (memq (car lst) (cdr lst))
          (has-dups (cdr lst)))))

;; does `expr` contain any substructure that satisfies predicate `p`?
(define (contains p expr)
  (or (p expr)
      (and (pair? expr)
           (any (lambda (x) (contains p x))
                expr))))

;; does `expr` contain something `eq?` to `x`, excluding list heads and quoted exprs
(define (expr-contains-eq x expr)
  (or (eq? expr x)
      (and (pair? expr)
           (not (quoted? expr))
           (any (lambda (y) (expr-contains-eq x y))
                (cdr expr)))))

;; same as above, with predicate
(define (expr-contains-p p expr (filt (lambda (x) #t)))
  (and (filt expr)
       (or (p expr)
           (and (pair? expr)
                (not (quoted? expr))
                (any (lambda (y) (expr-contains-p p y filt))
                     (cdr expr))))))

;; find all subexprs satisfying `p`, applying `key` to each one
(define (expr-find-all p expr key (filt (lambda (x) #t)))
  (if (filt expr)
      (let ((found (if (p expr)
                       (list (key expr))
                       '())))
        (if (or (atom? expr) (quoted? expr))
            found
            (apply nconc
                   found
                   (map (lambda (x) (expr-find-all p x key filt))
                        (cdr expr)))))
      '()))

(define (butlast lst)
  (if (or (null? lst) (null? (cdr lst)))
      '()
      (cons (car lst) (butlast (cdr lst)))))

(define (last lst)
  (if (null? (cdr lst))
      (car lst)
      (last (cdr lst))))

(define (take-while f xs)
  (cond ((null? xs) '())
        ((f (car xs)) (cons (car xs) (take-while f (cdr xs))))
        (else '())))

(define (caddddr x) (car (cdr (cdr (cdr (cdr x))))))
(define (cdddddr x) (cdr (cdr (cdr (cdr (cdr x))))))

(define (table.clone t)
  (let ((nt (table)))
    (table.foldl (lambda (k v z) (put! nt k v))
                 () t)
    nt))

;; `any`, but call predicate on every element in order no matter what
(define (eager-any pred lst)
  (let loop ((lst lst)
             (any #f))
    (if (null? lst)
        any
        (loop (cdr lst)
              (or (pred (car lst)) any)))))

;; construct a table mapping each element of `lst` to its index (1-indexed)
(define (symbol-to-idx-map lst)
  (let ((tbl (table)))
    (let loop ((xs lst) (i 1))
      (if (pair? xs)
          (begin (put! tbl (car xs) i)
                 (loop (cdr xs) (+ i 1)))))
    tbl))
back to top