aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/synthesizer/variable.lux
blob: 3a48cb3f211b4b462dc4355ac00c3538f5ecd4ad (plain)
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
97
98
99
100
(;module:
  lux
  (lux (data [bool "B/" Eq<Bool>]
             [text "T/" Eq<Text>]
             [number]
             (coll [list "L/" Functor<List> Fold<List> Monoid<List>]
                   ["s" set])))
  (luxc (lang ["la" analysis]
              ["ls" synthesis])
        (synthesizer ["&;" function])))

(def: (bound-vars path)
  (-> ls;Path (List ls;Variable))
  (case path
    (#ls;BindP register)
    (list (nat-to-int register))

    (^or (#ls;SeqP pre post) (#ls;AltP pre post))
    (L/append (bound-vars pre) (bound-vars post))
    
    _
    (list)))

(def: (path-bodies path)
  (-> ls;Path (List ls;Synthesis))
  (case path
    (#ls;ExecP body)
    (list body)

    (#ls;SeqP pre post)
    (path-bodies post)

    (#ls;AltP pre post)
    (L/append (path-bodies pre) (path-bodies post))
    
    _
    (list)))

(def: (non-arg? arity var)
  (-> ls;Arity ls;Variable Bool)
  (and (&function;local? var)
       (n.> arity (int-to-nat var))))

(type: Tracker (s;Set ls;Variable))

(def: init-tracker Tracker (s;new number;Hash<Int>))

(def: (unused-vars current-arity bound exprS)
  (-> ls;Arity (List ls;Variable) ls;Synthesis (List ls;Variable))
  (let [tracker (loop [exprS exprS
                       tracker (L/fold s;add init-tracker bound)]
                  (case exprS
                    (#ls;Variable var)
                    (if (non-arg? current-arity var)
                      (s;remove var tracker)
                      tracker)
                    
                    (#ls;Variant tag last? memberS)
                    (recur memberS tracker)

                    (#ls;Tuple membersS)
                    (L/fold recur tracker membersS)

                    (#ls;Call funcS argsS)
                    (L/fold recur (recur funcS tracker) argsS)
                    
                    (^or (#ls;Recur argsS)
                         (#ls;Procedure name argsS))
                    (L/fold recur tracker argsS)

                    (#ls;Let offset inputS outputS)
                    (|> tracker (recur inputS) (recur outputS))

                    (#ls;If testS thenS elseS)
                    (|> tracker (recur testS) (recur thenS) (recur elseS))

                    (#ls;Loop offset initsS bodyS)
                    (recur bodyS (L/fold recur tracker initsS))

                    (#ls;Case inputS outputPS)
                    (let [tracker' (L/fold s;add
                                           (recur inputS tracker)
                                           (bound-vars outputPS))]
                      (L/fold recur tracker' (path-bodies outputPS)))

                    (#ls;Function arity env bodyS)
                    (L/fold s;remove tracker env)

                    _
                    tracker
                    ))]
    (s;to-list tracker)))

## (def: (optimize-register-use current-arity [pathS bodyS])
##   (-> ls;Arity [ls;Path ls;Synthesis] [ls;Path ls;Synthesis])
##   (let [bound (bound-vars pathS)
##         unused (unused-vars current-arity bound bodyS)
##         adjusted (adjust-vars unused bound)]
##     [(|> pathS (clean-pattern adjusted) simplify-pattern)
##      (clean-expression adjusted bodyS)]))