dataflow-analysis/very-busy-expr.rkt at master · Kraks/dataflow-analysis · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
#lang racket

;; Very Busy Expression Analysis
;; An expression is very busy if, no matter what
;; path is taken, it will definitely be evaluated
;; again before its value changes.

(require "ast.rkt")
(require "parser.rkt")
(require "cfg.rkt")
(require "dfa.rkt")

(require rackunit)

(define very-busy-analysis
  (Analysis
   ; direction
   'backward
   ; init
   (λ (cfg node) (list->set (filter not-constant? (get-exprs cfg))))
   ; entry fact
   null
   ; exit fact
   (λ (fun cfg n) (set))
   ; gen
   (λ (cfg n)
     (match n
       [(Node (Assign id e) _)
        (if (not-constant? e) (set e) (set))]
       [else (set)]))
   ; kill
   (λ (cfg n)
     (match n
       [(Node (Assign id e) _)
        (list->set (filter (λ (e1) (expr-contains-var? e1 id))
                           (set->list (get-exprs cfg))))]
       [else (set)]))
   ; meet
   set-intersect
   ))

(define very-busy-exprs
  (chaotic-iteration very-busy-analysis))

(module+ test
  (define test-fun
    (parse-function '{test {}
                           {var a b x y}
                           {{if {== a b}
                                {{:= x {- b a}}
                                 {:= y {- a b}}}
                                {{:= y {- b a}}
                                 {:= a 0}
                                 {:= x {- a b}}}}
                            {return 0}}}))

  (define result (very-busy-exprs test-fun))
  (define result-IN (car result))
  (define result-OUT (cdr result))
  (check-equal? (make-immutable-hash (hash->list result-IN))
                (hash
                 (Node (Assign 'y (Minus 'a 'b)) 2)
                 (set (Minus 'a 'b))
                 (Node (Assign 'x (Minus 'b 'a)) 1)
                 (set (Minus 'a 'b) (Minus 'b 'a))
                 (Node (Assign 'a 0) 4)
                 (set)
                 (Node (Assign 'y (Minus 'b 'a)) 3)
                 (set (Minus 'b 'a))
                 (Node (Equal 'a 'b) 6)
                 (set (Minus 'b 'a))
                 (Node (Return 0) 8)
                 (set)
                 (Node (NoOp) 7)
                 (set)
                 (Node (Assign 'x (Minus 'a 'b)) 5)
                 (set (Minus 'a 'b))))

  (check-equal? (make-immutable-hash (hash->list result-OUT))
                (hash
                 (Node (Assign 'y (Minus 'a 'b)) 2)
                 (set)
                 (Node (Assign 'x (Minus 'b 'a)) 1)
                 (set (Minus 'a 'b))
                 (Node (Assign 'a 0) 4)
                 (set (Minus 'a 'b))
                 (Node (Assign 'y (Minus 'b 'a)) 3)
                 (set)
                 (Node (Equal 'a 'b) 6)
                 (set (Minus 'b 'a))
                 (Node (Return 0) 8)
                 (set)
                 (Node (NoOp) 7)
                 (set)
                 (Node (Assign 'x (Minus 'a 'b)) 5)
                 (set))))