aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/loop.jvm.lux
blob: f5830bf9ef06442f419985578e009cc182be4d81 (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
(;module:
  lux
  (lux (control [monad #+ do])
       (data [text]
             text/format
             (coll [list "list/" Functor<List> Monoid<List>]))
       [macro])
  (luxc ["&" lang]
        (lang [";L" host]
              (host ["$" jvm]
                    (jvm ["$t" type]
                         ["$d" def]
                         ["$i" inst]))
              ["la" analysis]
              ["ls" synthesis]
              (translation [";T" common]
                           [";T" runtime]
                           [";T" reference])
              [";L" variable #+ Variable])))

(def: #export (translate-recur translate argsS)
  (-> (-> ls;Synthesis (Meta $;Inst))
      (List ls;Synthesis)
      (Meta $;Inst))
  (do macro;Monad<Meta>
    [[@begin offset] hostL;anchor
     argsI (monad;map @ (function [[register argS]]
                          (let [register' (|> register (n.+ offset))]
                            (: (Meta $;Inst)
                               (case argS
                                 (^multi (^code ((~ [_ (#;Int var)])))
                                         (i.= (variableL;local register')
                                              var))
                                 (wrap id)

                                 _
                                 (do @
                                   [argI (translate argS)]
                                   (wrap (|>. argI
                                              ($i;ASTORE register'))))))))
                      (list;zip2 (list;n.range +0 (n.dec (list;size argsS)))
                                 argsS))]
    (wrap (|>. ($i;fuse argsI)
               ($i;GOTO @begin)))))

(def: #export (translate-loop translate offset initsS+ bodyS)
  (-> (-> ls;Synthesis (Meta $;Inst))
      Nat (List ls;Synthesis) ls;Synthesis
      (Meta $;Inst))
  (do macro;Monad<Meta>
    [@begin $i;make-label
     initsI+ (monad;map @ translate initsS+)
     bodyI (hostL;with-anchor [@begin (n.inc offset)]
             (translate bodyS))
     #let [initializationI (|> (list;enumerate initsI+)
                               (list/map (function [[register initI]]
                                           (|>. initI
                                                ($i;ASTORE (|> register n.inc (n.+ offset))))))
                               $i;fuse)]]
    (wrap (|>. initializationI
               ($i;label @begin)
               bodyI))))