aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux
blob: 40f4decd95e4f2335a7e0d921382d649191d526a (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
(.module:
  [lux #*
   [control
    ["." monad (#+ do)]]
   [data
    ["." text
     format]
    [collection
     ["." list ("list/." Functor<List> Monoid<List>)]]]
   [platform
    [compiler
     [reference (#+ Register)]
     ["." phase
      ["." synthesis (#+ Synthesis)]
      ["." translation]]]]]
  [luxc
   [lang
    [host
     [jvm (#+ Inst Operation Phase)
      ["_" inst]]]]]
  ["." //])

(def: (constant? register changeS)
  (-> Register Synthesis Bit)
  (case changeS
    (^ (synthesis.variable/local var))
    (n/= register var)

    _
    #0))

(def: #export (recur translate argsS)
  (-> Phase (List Synthesis) (Operation Inst))
  (do phase.Monad<Operation>
    [[@begin start] translation.anchor
     #let [end (|> argsS list.size dec (n/+ start))
           pairs (list.zip2 (list.n/range start end)
                            argsS)]
     ## It may look weird that first I compile the values separately,
     ## and then I compile the stores/allocations.
     ## It must be done that way in order to avoid a potential bug.
     ## Let's say that you'll recur with 2 expressions: X and Y.
     ## If Y depends on the value of X, and you don't compile values
     ## and stores separately, then by the time Y is evaluated, it
     ## will refer to the new value of X, instead of the old value, as
     ## should be the case.
     valuesI+ (monad.map @ (function (_ [register argS])
                             (: (Operation Inst)
                                (if (constant? register argS)
                                  (wrap id)
                                  (translate argS))))
                         pairs)
     #let [storesI+ (list/map (function (_ [register argS])
                                (: Inst
                                   (if (constant? register argS)
                                     id
                                     (_.ASTORE register))))
                              (list.reverse pairs))]]
    (wrap (|>> (_.fuse valuesI+)
               (_.fuse storesI+)
               (_.GOTO @begin)))))

(def: #export (scope translate [start initsS+ iterationS])
  (-> Phase [Nat (List Synthesis) Synthesis] (Operation Inst))
  (do phase.Monad<Operation>
    [@begin _.make-label
     initsI+ (monad.map @ translate initsS+)
     iterationI (translation.with-anchor [@begin start]
                  (translate iterationS))
     #let [initializationI (|> (list.enumerate initsI+)
                               (list/map (function (_ [register initI])
                                           (|>> initI
                                                (_.ASTORE (n/+ start register)))))
                               _.fuse)]]
    (wrap (|>> initializationI
               (_.label @begin)
               iterationI))))