(.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 [ruby #+ Ruby Expression Statement]))))

(def: prefix Text "LuxRuntime")

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

(def: (flag value)
  (-> Bool Ruby)
  (if value
    (ruby.string "")
    ruby.nil))

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

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

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

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

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

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

(type: Runtime Ruby)

(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+) (` ruby.Ruby)))
                    ruby.Ruby))]
    (wrap (list (` (def: #export (~ declaration)
                     (~ type)
                     (ruby.apply (~ runtime) (list (~+ argsC+)))))
                (` (def: (~ implementation)
                     Ruby
                     (~ (case argsC+
                          #.Nil
                          (` (ruby.set! (list (~ runtime)) (~ definition)))

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

(runtime: (lux//try op)
  (ruby.begin! (ruby.block! (list (ruby.set! (list "value") (ruby.call (list unit) op))
                                  (ruby.return! (right "value"))))
               (list [(list) "error"
                      (ruby.return! (left (ruby.field "message" "error")))])))

(runtime: (lux//program-args program-args)
  (ruby.block! (list (ruby.set! (list "inputs") none)
                     (ruby.for-in! "value" program-args
                                   (ruby.set! (list "inputs") (some (ruby.array (list "value" "inputs")))))
                     (ruby.return! "inputs"))))

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

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

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

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

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

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

                no-match!)))

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

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

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

(runtime: (text//index subject param start)
  (ruby.block! (list (ruby.set! (list "idx") (ruby.send "index" (list param start) subject))
                     (ruby.if! (ruby.= ruby.nil "idx")
                               (ruby.return! none)
                               (ruby.return! (some "idx"))))))

(runtime: (text//clip text from to)
  (ruby.if! ($_ ruby.and
                (ruby.>= (ruby.int 0) from)
                (ruby.< (ruby.send "length" (list) text) from)
                (ruby.>= (ruby.int 0) to)
                (ruby.< (ruby.send "length" (list) text) to)
                (ruby.<= to from))
            (ruby.return! (some (ruby.array-range from to text)))
            (ruby.return! none)))

(runtime: (text//char text idx)
  (ruby.if! (ruby.and (ruby.>= (ruby.int 0) idx)
                      (ruby.< (ruby.send "length" (list) text) idx))
            (ruby.return! (some (ruby.send "ord" (list)
                                           (ruby.array-range idx idx text))))
            (ruby.return! none)))

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

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

(runtime: (array//get array idx)
  (<| (check-index-out-of-bounds array idx)
      (ruby.block! (list (ruby.set! (list "temp") (ruby.nth idx array))
                         (ruby.if! (ruby.= ruby.nil "temp")
                                   (ruby.return! none)
                                   (ruby.return! (some "temp")))))))

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

(def: runtime//array
  Runtime
  (format @@array//get
          @@array//put))

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

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

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

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

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

(runtime: (process//schedule milli-seconds procedure)
  (ruby.block!
   (list (format "(Thread.new {"
                 (ruby.when! (ruby.not (ruby.= (ruby.int 0) milli-seconds))
                             (ruby.statement (ruby.apply "sleep" (list (ruby./ (ruby.float 1_000.0) milli-seconds)))))
                 (ruby.statement (ruby.call (list ..unit) procedure))
                 "})")
         (ruby.return! ..unit))))

(def: runtime//process
  Runtime
  @@process//schedule)

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

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

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