(.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]
              [".L" variable #+ Variable Register]))
  (// [".T" common]
      [".T" runtime]
      [".T" reference]))

(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))))