(.module:
  lux
  (lux (control ["p" parser "p/" Monad<Parser>]
                [monad #+ do])
       (data text/format
             (coll [list "list/" Monad<List>]))
       [macro]
       (macro [code]
              ["s" syntax #+ syntax:])
       [io #+ Process])
  [//]
  (luxc [lang]
        (lang (host [lua #+ Lua Expression Statement]))))

(def: prefix Text "LuxRuntime")

(def: #export unit Expression (%t //.unit))

(def: (flag value)
  (-> Bit Lua)
  (if value
    (lua.string "")
    lua.nil))

(def: (variant' tag last? value)
  (-> Expression Expression Expression Expression)
  (lua.table (list [//.variant-tag-field tag]
                   [//.variant-flag-field last?]
                   [//.variant-value-field value])))

(def: #export (variant tag last? value)
  (-> Nat Bit Expression Expression)
  (variant' (%i (.int tag)) (flag last?) value))

(def: none
  Expression
  (variant +0 false unit))

(def: some
  (-> Expression Expression)
  (variant +1 true))

(def: left
  (-> Expression Expression)
  (variant +0 false))

(def: right
  (-> Expression Expression)
  (variant +1 true))

(type: Runtime Lua)

(def: declaration
  (s.Syntax [Text (List Text)])
  (p.either (p.seq s.local-symbol (p/wrap (list)))
            (s.form (p.seq s.local-symbol (p.some s.local-symbol)))))

(syntax: (runtime: {[name args] declaration}
           definition)
  (let [implementation (code.local-symbol (format "@@" name))
        runtime (code.text (format "__" prefix "__" (lang.normalize-name name)))
        argsC+ (list/map code.local-symbol args)
        argsLC+ (list/map (|>> lang.normalize-name code.text) args)
        declaration (` ((~ (code.local-symbol name))
                        (~+ argsC+)))
        type (` (-> (~+ (list.repeat (list.size argsC+) (` lua.Lua)))
                    lua.Lua))]
    (wrap (list (` (def: #export (~ declaration)
                     (~ type)
                     (lua.apply (~ runtime) (list (~+ argsC+)))))
                (` (def: (~ implementation)
                     Lua
                     (~ (case argsC+
                          #.Nil
                          (` (lua.global! (~ runtime) (#.Some (~ definition))))

                          _
                          (` (let [(~' @) (~ runtime)
                                   (~+ (|> (list.zip2 argsC+ argsLC+)
                                           (list/map (function (_ [left right]) (list left right)))
                                           list/join))]
                               (lua.function! (~ runtime) (list (~+ argsLC+))
                                              (~ definition))))))))))))

(runtime: (array//copy array)
  (lua.block! (list (lua.local! "temp" (#.Some (lua.array (list))))
                    (lua.for-step! "idx" (lua.int 1) (lua.length array) (lua.int 1)
                                   (lua.apply "table.insert" (list "temp" (lua.nth "idx" array))))
                    (lua.return! "temp"))))

(runtime: (array//sub array from to)
  (lua.block! (list (lua.local! "temp" (#.Some (lua.array (list))))
                    (lua.for-step! "idx" from to (lua.int 1)
                                   (lua.apply "table.insert" (list "temp" (lua.nth "idx" array))))
                    (lua.return! "temp"))))

(runtime: (array//concat left right)
  (let [copy! (function (_ input output)
                (lua.for-step! "idx" (lua.int 1) (format input ".n") (lua.int 1)
                               (lua.apply "table.insert" (list output (lua.nth "idx" input)))))]
    (lua.block! (list (lua.local! "temp" (#.Some (lua.array (list))))
                      (copy! left "temp")
                      (copy! right "temp")
                      (lua.return! "temp")))))

(runtime: (lux//try op)
  (lua.block! (list (format "local success, value = " (lua.apply "pcall" (list (lua.function (list) (lua.return! (lua.apply op (list unit)))))) ";")
                    (lua.if! "success"
                             (lua.return! (right "value"))
                             (lua.return! (left "value"))))))

(runtime: (lux//program-args program-args)
  (lua.block! (list (lua.local! "inputs" (#.Some none))
                    (lua.for-step! "idx" (lua.length program-args) (lua.int 1) (lua.int -1)
                                   (lua.set! "inputs" (some (lua.array (list (lua.nth "idx" program-args)
                                                                             "inputs")))))
                    (lua.return! "inputs"))))

(def: runtime//lux
  Runtime
  (format @@lux//try
          @@lux//program-args))

(runtime: (product//left product index)
  (lua.block! (list (lua.local! "index_min_length" (#.Some (lua.+ (lua.int 1) index)))
                    (lua.if! (lua.>= "index_min_length" (lua.length product))
                             ## No need for recursion
                             (lua.return! (lua.nth "index_min_length" product))
                             ## Needs recursion
                             (lua.return! (product//left (lua.nth (lua.length product)
                                                                  product)
                                                         (lua.- (lua.length product)
                                                                "index_min_length")))))))

(runtime: (product//right product index)
  (lua.block! (list (lua.local! "index_min_length" (#.Some (lua.+ (lua.int 1) index)))
                    (lua.cond! (list [(lua.= "index_min_length" (lua.length product))
                                      ## Last element.
                                      (lua.return! (lua.nth "index_min_length" product))]
                                     [(lua.< "index_min_length" (lua.length product))
                                      ## Needs recursion
                                      (lua.return! (product//right (lua.nth (lua.length product)
                                                                            product)
                                                                   (lua.- (lua.length product)
                                                                          "index_min_length")))])
                               ## Must slice
                               (lua.return! (array//sub product "index_min_length" (lua.length product)))))))

(runtime: (sum//get sum wantedTag wantsLast)
  (let [no-match! (lua.return! lua.nil)
        sum-tag (format "sum." //.variant-tag-field)
        sum-flag (format "sum." //.variant-flag-field)
        sum-value (format "sum." //.variant-value-field)
        is-last? (lua.= (lua.string "") sum-flag)
        test-recursion! (lua.if! is-last?
                                 ## Must recurse.
                                 (lua.return! (sum//get sum-value (lua.- sum-tag wantedTag) wantsLast))
                                 no-match!)]
    (lua.cond! (list [(lua.= sum-tag wantedTag)
                      (lua.if! (lua.= wantsLast sum-flag)
                               (lua.return! sum-value)
                               test-recursion!)]

                     [(lua.> sum-tag wantedTag)
                      test-recursion!]

                     [(lua.and (lua.< sum-tag wantedTag)
                               (lua.= (lua.string "") wantsLast))
                      (lua.return! (variant' (lua.- wantedTag sum-tag) sum-flag sum-value))])

               no-match!)))

(def: runtime//adt
  Runtime
  (format @@product//left
          @@product//right
          @@sum//get))

(runtime: (bit//logical-right-shift param subject)
  (let [mask (|> (lua.int 1)
                 (lua.bit-shl (lua.- param (lua.int 64)))
                 (lua.- (lua.int 1)))]
    (lua.return! (|> subject
                     (lua.bit-shr param)
                     (lua.bit-and mask)))))

(def: runtime//bit
  Runtime
  @@bit//logical-right-shift)

(runtime: (text//index subject param start)
  (lua.block! (list (lua.local! "idx" (#.Some (lua.apply "string.find" (list subject param start (lua.bool true)))))
                    (lua.if! (lua.= lua.nil "idx")
                             (lua.return! none)
                             (lua.return! (some "idx"))))))

(runtime: (text//clip text from to)
  (lua.block! (list (lua.local! "size" (#.Some (lua.apply "string.len" (list text))))
                    (lua.if! (lua.or (lua.> "size" from)
                                     (lua.> "size" to))
                             (lua.return! none)
                             (lua.return! (some (lua.apply "string.sub" (list text from to))))))))

(runtime: (text//char text idx)
  (lua.block! (list (lua.local! "char" (#.Some (lua.apply "string.byte" (list text idx))))
                    (lua.if! (lua.= lua.nil "char")
                             (lua.return! none)
                             (lua.return! (some "char"))))))

(def: runtime//text
  Runtime
  (format @@text//index
          @@text//clip
          @@text//char))

(def: (check-index-out-of-bounds array idx body!)
  (-> Expression Expression Statement Statement)
  (lua.if! (lua.<= (lua.length array)
                   idx)
           body!
           (lua.error (lua.string "Array index out of bounds!"))))

(runtime: (array//new size)
  (lua.block! (list (lua.local! "output" (#.Some (lua.array (list))))
                    (lua.for-step! "idx" (lua.int 1) size (lua.int 1)
                                   (lua.apply "table.insert" (list "output" unit)))
                    (lua.return! "output"))))

(runtime: (array//get array idx)
  (<| (check-index-out-of-bounds array idx)
      (lua.block! (list (lua.local! "temp" (#.Some (lua.nth idx array)))
                        (lua.if! (lua.or (lua.= lua.nil "temp")
                                         (lua.= unit "temp"))
                                 (lua.return! none)
                                 (lua.return! (some "temp")))))))

(runtime: (array//put array idx value)
  (<| (check-index-out-of-bounds array idx)
      (lua.block! (list (lua.set! (lua.nth idx array) value)
                        (lua.return! array)))))

(def: runtime//array
  Runtime
  (format @@array//sub
          @@array//concat
          @@array//copy
          @@array//new
          @@array//get
          @@array//put
          ))

(def: #export atom//field Text "_lux_atom")

(runtime: (atom//compare-and-swap atom old new)
  (let [atom//field (lua.string atom//field)]
    (lua.if! (lua.= old (lua.nth atom//field atom))
             (lua.block! (list (lua.set! (lua.nth atom//field atom) new)
                               (lua.return! (lua.bool true))))
             (lua.return! (lua.bool false)))))

(def: runtime//atom
  Runtime
  (format @@atom//compare-and-swap))

(runtime: (box//write value box)
  (lua.block! (list (lua.set! (lua.nth (lua.int 0) box)
                              value)
                    (lua.return! unit))))

(def: runtime//box
  Runtime
  (format @@box//write))

(def: process//incoming
  Text
  (lang.normalize-name "process//incoming"))

(runtime: (process//loop _)
  (let [migrate-incoming! (lua.block! (list (lua.for-step! "idx" (lua.int 1) (lua.length process//incoming) (lua.int 1)
                                                           (lua.apply "table.insert" (list "queue" (lua.nth "idx" process//incoming))))
                                            (lua.set! process//incoming (lua.array (list)))))
        consume-queue! (lua.block! (list (lua.local! "survivors" (#.Some (lua.array (list))))
                                         (lua.local! "active_processes" (#.Some (lua.length "queue")))
                                         (lua.for-step! "idx" (lua.int 1) "active_processes" (lua.int 1)
                                                        (lua.block! (list (lua.local! "process" (#.Some (lua.nth "idx" "queue")))
                                                                          (lua.when! (lua.apply "coroutine.resume" (list "process"))
                                                                                     (lua.apply "table.insert" (list "survivors" "process"))))))
                                         (lua.set! "queue" "survivors")))
        loop-body! (lua.block! (list migrate-incoming!
                                     consume-queue!))]
    (lua.block! (list (lua.local! "queue" (#.Some (lua.array (list))))
                      loop-body!
                      (lua.while! (|> (lua.length "queue") (lua.> (lua.int 0)))
                                  loop-body!)))))

(runtime: (process//schedule milli-seconds procedure)
  (let [now (lua.apply "os.time" (list))]
    (lua.if! (lua.= (lua.int 0) milli-seconds)
             (lua.apply "table.insert" (list process//incoming
                                             (lua.function (list)
                                               (lua.return! (lua.apply procedure (list unit))))))
             (lua.block! (list (lua.local! "start" (#.Some now))
                               (lua.local! "seconds" (#.Some (lua.// (lua.int 1_000)
                                                                     milli-seconds)))
                               (lua.apply "table.insert" (list process//incoming
                                                               (lua.function (list)
                                                                 (lua.block! (list (lua.while! (lua.< "seconds" (lua.- "start" now))
                                                                                               (lua.apply "coroutine.yield" (list)))
                                                                                   (lua.return! (lua.apply procedure (list unit))))))))
                               (lua.return! unit))))))

(def: runtime//process
  Runtime
  (format (lua.global! process//incoming (#.Some (lua.array (list))))
          @@process//loop
          @@process//schedule))

(runtime: (lua//get object field)
  (lua.block! (list (lua.local! "value" (#.Some (lua.nth field object)))
                    (lua.if! (lua.= lua.nil "value")
                             (lua.return! none)
                             (lua.return! (some "value"))))))

(runtime: (lua//set object field value)
  (lua.block! (list (lua.set! (lua.nth field object) value)
                    (lua.return! object))))

(def: runtime//lua
  Runtime
  (format @@lua//get
          @@lua//set))

(def: runtime
  Runtime
  (format runtime//lux
          runtime//adt
          runtime//bit
          runtime//text
          runtime//array
          runtime//atom
          runtime//box
          runtime//process
          runtime//lua))

(def: #export artifact Text (format prefix ".lua"))

(def: #export translate
  (Meta (Process Any))
  (do macro.Monad<Meta>
    [_ //.init-module-buffer
     _ (//.save runtime)]
    (//.save-module! artifact)))