(;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 Register])))

(def: (constant? register changeS)
  (-> Register ls;Synthesis Bool)
  (case changeS
    (^multi (^code ((~ [_ (#;Int var)])))
            (i.= (variableL;local register)
                 var))
    true

    _
    false))

(def: #export (translate-recur translate argsS)
  (-> (-> ls;Synthesis (Meta $;Inst))
      (List ls;Synthesis)
      (Meta $;Inst))
  (do macro;Monad<Meta>
    [[@begin offset] hostL;anchor
     #let [pairs (list;zip2 (list;n.range offset (|> (list;size argsS) n.dec (n.+ offset)))
                            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
     ## must be the case.
     valuesI+ (monad;map @ (function [[register argS]]
                             (: (Meta $;Inst)
                                (if (constant? register argS)
                                  (wrap id)
                                  (translate argS))))
                         pairs)
     #let [storesI+ (list/map (function [[register argS]]
                                (: $;Inst
                                   (if (constant? register argS)
                                     id
                                     ($i;ASTORE register))))
                              (list;reverse pairs))]]
    (wrap (|>. ($i;fuse valuesI+)
               ($i;fuse storesI+)
               ($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 offset]
             (translate bodyS))
     #let [initializationI (|> (list;enumerate initsI+)
                               (list/map (function [[register initI]]
                                           (|>. initI
                                                ($i;ASTORE (n.+ offset register)))))
                               $i;fuse)]]
    (wrap (|>. initializationI
               ($i;label @begin)
               bodyI))))