path: root/lux-lua/source/program.lux

(.using
 [library
  [lux (.except)
   [program (.only program:)]
   ["[0]" ffi]
   ["[0]" static]
   [abstract
    ["[0]" monad (.only do)]]
   [control
    ["[0]" maybe]
    ["[0]" try (.only Try)]
    ["[0]" exception (.only exception:)]
    ["[0]" io (.only IO io)]
    ["[0]" function]
    [concurrency
     ["[0]" async (.only Async)]]]
   [data
    ["[0]" text (.open: "[1]#[0]" hash)
     ["%" \\format (.only format)]
     [encoding
      ["[0]" utf8]]]
    [collection
     ["[0]" array (.only Array)]
     ["[0]" list (.open: "[1]#[0]" monad)]]]
   [macro
    ["^" pattern]
    ["[0]" local]
    ["[0]" code]]
   [math
    [number (.only hex)
     ["n" nat]
     ["[0]" i64]]]
   ["[0]" world
    ["[0]" file]
    ["[1]/[0]" program]]
   ["@" target (.only)
    ["_" lua]]
   [tool
    ["[0]" compiler
     ["[0]" phase (.only Operation Phase)]
     [reference
      [variable (.only Register)]]
     [language
      [lux
       [program (.only Program)]
       [generation (.only Host)]
       [analysis
        [macro (.only Expander)]]
       [phase
        ["[0]" extension (.only Extender Handler)
         ["[1]/[0]" bundle]
         ["[0]" analysis
          ["[1]" lua]]
         ["[0]" generation
          ["[1]" lua]]]
        [generation
         ["[0]" reference]
         ["[0]" lua (.only)
          ["[0]" runtime]]]]]]
     [default
      ["[0]" platform (.only Platform)]]
     [meta
      ["[0]" cli]
      ["[0]" context]
      [archive (.only Archive)]
      ["[0]" packager
       ["[1]" script]]]]]]]
 [program
  ["/" compositor]])

(with_expansions [<jvm> (these (ffi.import java/lang/String
                                 "[1]::[0]")

                               (ffi.import (java/lang/Class a)
                                 "[1]::[0]")

                               (ffi.import java/lang/Object
                                 "[1]::[0]"
                                 (toString [] java/lang/String)
                                 (getClass [] (java/lang/Class java/lang/Object)))

                               (ffi.import java/lang/Integer
                                 "[1]::[0]")

                               (ffi.import java/lang/Long
                                 "[1]::[0]"
                                 (intValue [] int))

                               (ffi.import net/sandius/rembulan/StateContext
                                 "[1]::[0]")

                               (ffi.import net/sandius/rembulan/impl/StateContexts
                                 "[1]::[0]"
                                 ("static" newDefaultInstance [] net/sandius/rembulan/StateContext))

                               (ffi.import net/sandius/rembulan/env/RuntimeEnvironment
                                 "[1]::[0]")

                               (ffi.import net/sandius/rembulan/env/RuntimeEnvironments
                                 "[1]::[0]"
                                 ("static" system [] net/sandius/rembulan/env/RuntimeEnvironment))

                               (ffi.import net/sandius/rembulan/Table
                                 "[1]::[0]"
                                 (rawget "as" get_idx [long] "?" java/lang/Object)
                                 (rawget "as" get_key [java/lang/Object] "?" java/lang/Object)
                                 (rawlen [] long))

                               (ffi.import net/sandius/rembulan/ByteString
                                 "[1]::[0]"
                                 (decode [] java/lang/String))

                               (ffi.import net/sandius/rembulan/impl/DefaultTable
                                 "[1]::[0]")

                               (ffi.import net/sandius/rembulan/impl/ImmutableTable
                                 "[1]::[0]")

                               (ffi.import net/sandius/rembulan/impl/ImmutableTable$Builder
                                 "[1]::[0]"
                                 (new [])
                                 (build [] net/sandius/rembulan/impl/ImmutableTable))

                               (ffi.import net/sandius/rembulan/lib/StandardLibrary
                                 "[1]::[0]"
                                 ("static" in [net/sandius/rembulan/env/RuntimeEnvironment] net/sandius/rembulan/lib/StandardLibrary)
                                 (installInto [net/sandius/rembulan/StateContext] net/sandius/rembulan/Table))

                               (ffi.import net/sandius/rembulan/Variable
                                 "[1]::[0]"
                                 (new [java/lang/Object]))

                               (ffi.import net/sandius/rembulan/runtime/ReturnBuffer
                                 "[1]::[0]"
                                 (setTo [java/lang/Object] void))
                               
                               (ffi.import net/sandius/rembulan/runtime/ExecutionContext
                                 "[1]::[0]"
                                 (getReturnBuffer [] net/sandius/rembulan/runtime/ReturnBuffer))
                               
                               (ffi.import net/sandius/rembulan/runtime/ResolvedControlThrowable
                                 "[1]::[0]")
                               
                               (ffi.import net/sandius/rembulan/runtime/LuaFunction
                                 "[1]::[0]")

                               (ffi.import net/sandius/rembulan/load/ChunkLoader
                                 "[1]::[0]"
                                 (loadTextChunk [net/sandius/rembulan/Variable
                                                 java/lang/String
                                                 java/lang/String]
                                                "try" net/sandius/rembulan/runtime/LuaFunction))

                               (ffi.import net/sandius/rembulan/compiler/CompilerChunkLoader
                                 "[1]::[0]"
                                 ("static" of [java/lang/String] net/sandius/rembulan/compiler/CompilerChunkLoader))

                               (ffi.import net/sandius/rembulan/runtime/SchedulingContext
                                 "[1]::[0]")

                               (ffi.import net/sandius/rembulan/runtime/SchedulingContextFactory
                                 "[1]::[0]")

                               (ffi.import net/sandius/rembulan/exec/DirectCallExecutor
                                 "[1]::[0]"
                                 ("static" newExecutor [] net/sandius/rembulan/exec/DirectCallExecutor)
                                 (schedulingContextFactory [] net/sandius/rembulan/runtime/SchedulingContextFactory)
                                 (call [net/sandius/rembulan/StateContext java/lang/Object [java/lang/Object]] "try" [java/lang/Object]))

                               (exception: (unknown_kind_of_object [object java/lang/Object])
                                 (exception.report
                                  "Class" (ffi.of_string (java/lang/Object::toString (java/lang/Object::getClass object)))
                                  "Object" (ffi.of_string (java/lang/Object::toString object))))

                               (ffi.interface LuxValue
                                 (getValue [] java/lang/Object))

                               (ffi.import LuxValue
                                 "[1]::[0]"
                                 (getValue [] java/lang/Object))

                               (type: Translator
                                 (-> java/lang/Object (Try Any)))

                               (def: (read_variant read host_object)
                                 (-> Translator net/sandius/rembulan/impl/DefaultTable (Try Any))
                                 (case [(net/sandius/rembulan/Table::get_key (as java/lang/Object runtime.variant_tag_field) host_object)
                                        (net/sandius/rembulan/Table::get_key (as java/lang/Object runtime.variant_flag_field) host_object)
                                        (net/sandius/rembulan/Table::get_key (as java/lang/Object runtime.variant_value_field) host_object)]
                                   (^.multi [{.#Some tag} ?flag {.#Some value}]
                                            [(read value)
                                             {try.#Success value}])
                                   {try.#Success [(is Any (|> tag
                                                              (as Int)
                                                              ffi.as_long
                                                              java/lang/Long::intValue
                                                              (is java/lang/Integer)))
                                                  (is Any (case ?flag
                                                            {.#Some _} (is Any "")
                                                            {.#None} (as Any (ffi.null))))
                                                  (is Any value)]}

                                   _
                                   (exception.except ..unknown_kind_of_object [(as java/lang/Object host_object)])))

                               (def: (read_tuple read host_object)
                                 (-> Translator net/sandius/rembulan/impl/DefaultTable (Try Any))
                                 (let [init_num_keys (.nat (ffi.of_long (net/sandius/rembulan/Table::rawlen host_object)))]
                                   (loop (again [num_keys init_num_keys
                                                 idx 0
                                                 output (is (Array java/lang/Object)
                                                            (array.empty init_num_keys))])
                                     (if (n.< num_keys idx)
                                       (case (net/sandius/rembulan/Table::get_idx (ffi.as_long (.int (++ idx))) host_object)
                                         {.#None}
                                         (again num_keys (++ idx) output)

                                         {.#Some member}
                                         (case (read member)
                                           {try.#Success parsed_member}
                                           (again num_keys (++ idx) (array.has! idx (as java/lang/Object parsed_member) output))

                                           {try.#Failure error}
                                           {try.#Failure error}))
                                       {try.#Success output}))))

                               (exception: .public nil_has_no_lux_representation)

                               (def: (read host_object)
                                 Translator
                                 (`` (<| (if (ffi.null? host_object)
                                           (exception.except ..nil_has_no_lux_representation []))
                                         (~~ (with_template [<class> <post_processing>]
                                               [(case (ffi.as <class> host_object)
                                                  {.#Some typed_object}
                                                  (|> typed_object <post_processing>)

                                                  _)]

                                               [LuxValue (<| {try.#Success} LuxValue::getValue)]
                                               [java/lang/Boolean {try.#Success}]
                                               [java/lang/Long {try.#Success}]
                                               [java/lang/Double {try.#Success}]
                                               [java/lang/String {try.#Success}]
                                               [net/sandius/rembulan/ByteString (<| {try.#Success} net/sandius/rembulan/ByteString::decode)]
                                               [net/sandius/rembulan/runtime/LuaFunction {try.#Success}]
                                               ))
                                         (case (ffi.as net/sandius/rembulan/impl/DefaultTable host_object)
                                           {.#Some typed_object}
                                           (case (read_variant read typed_object)
                                             {try.#Failure error}
                                             (read_tuple read typed_object)

                                             success
                                             success)

                                           _)
                                         (exception.except ..unknown_kind_of_object [host_object])
                                         )))

                               (def: (return ec value)
                                 (-> net/sandius/rembulan/runtime/ExecutionContext Any Any)
                                 (|> ec
                                     net/sandius/rembulan/runtime/ExecutionContext::getReturnBuffer
                                     (net/sandius/rembulan/runtime/ReturnBuffer::setTo (as java/lang/Object value))))

                               (def: (function/* arity)
                                 (-> Nat Code)
                                 (` (.-> (~+ (list.repeated arity (` .Any)))
                                         .Any)))

                               (def: input/*
                                 (-> Nat (List Code))
                                 (|>> list.indices
                                      (list#each (|>> %.nat (format "input/") code.local))))

                               (def: declaration/*
                                 (-> Nat (List Code))
                                 (|>> ..input/*
                                      (list#each (function (_ $input)
                                                   (list $input (' java/lang/Object))))
                                      list#conjoint))

                               (def: read/*
                                 (-> Nat (List Code))
                                 (|>> ..input/*
                                      (list#each (function (_ $input)
                                                   (list $input (` (..read (~ $input))))))
                                      list#conjoint))

                               (def: (apply/* to_host self parameters abstraction)
                                 (-> (-> Any java/lang/Object) net/sandius/rembulan/runtime/LuaFunction (List java/lang/Object) Any Any)
                                 (<| try.trusted
                                     (do [! try.monad]
                                       [input/* (monad.each ! ..read parameters)]
                                       (loop (again [lux_function abstraction
                                                     input/* input/*])
                                         (`` (`` (case input/*
                                                   (pattern (list))
                                                   (in self)
                                                   
                                                   (~~ (with_template [<arity>]
                                                         [(pattern (list (~~ (static.literals function.identity (..input/* <arity>)))))
                                                          (in (to_host ((as (~~ (static.literal function.identity (..function/* <arity>)))
                                                                            lux_function)
                                                                        (~~ (static.literals function.identity (..input/* <arity>))))))]

                                                         [1]
                                                         [2]
                                                         [3]
                                                         [4]
                                                         [5]
                                                         ))
                                                   
                                                   (pattern (list.partial (~~ (static.literals function.identity (..input/* 5))) input/+))
                                                   (again ((as (~~ (static.literal function.identity (..function/* 5)))
                                                               lux_function)
                                                           (~~ (static.literals function.identity (..input/* 5))))
                                                          input/+)
                                                   )))))))
                               
                               (def: (lua_function to_host lux_function)
                                 (-> (-> Any java/lang/Object) Any net/sandius/rembulan/runtime/LuaFunction)
                                 (<| (as net/sandius/rembulan/runtime/LuaFunction)
                                     (`` (`` (ffi.object [] net/sandius/rembulan/runtime/LuaFunction [LuxValue]
                                               []
                                               ... Methods
                                               (LuxValue
                                                [] (getValue self []) java/lang/Object
                                                (as java/lang/Object lux_function))
                                               
                                               (net/sandius/rembulan/runtime/LuaFunction
                                                [] (invoke self [% net/sandius/rembulan/runtime/ExecutionContext])
                                                void
                                                "throws" [net/sandius/rembulan/runtime/ResolvedControlThrowable]
                                                (<| (..return %)
                                                    self))

                                               (~~ (with_template [<arity>]
                                                     [(net/sandius/rembulan/runtime/LuaFunction
                                                       [] (invoke self [% net/sandius/rembulan/runtime/ExecutionContext
                                                                        (~~ (static.literals function.identity (..declaration/* <arity>)))])
                                                       void
                                                       "throws" [net/sandius/rembulan/runtime/ResolvedControlThrowable]
                                                       (<| (..return %)
                                                           (apply/* to_host
                                                                    (ffi.is net/sandius/rembulan/runtime/LuaFunction self)
                                                                    (list (~~ (static.literals function.identity (..input/* <arity>))))
                                                                    lux_function)))]

                                                     [1]
                                                     [2]
                                                     [3]
                                                     [4]
                                                     [5]
                                                     ))

                                               (net/sandius/rembulan/runtime/LuaFunction
                                                [] (invoke self [% net/sandius/rembulan/runtime/ExecutionContext
                                                                 input/* [java/lang/Object]])
                                                void
                                                "throws" [net/sandius/rembulan/runtime/ResolvedControlThrowable]
                                                (<| (..return %)
                                                    (apply/* to_host
                                                             (ffi.is net/sandius/rembulan/runtime/LuaFunction self)
                                                             (array.list {.#None} input/*)
                                                             lux_function)))
                                               )))))

                               (ffi.import library/lux/Function
                                 "[1]::[0]")

                               (def: (lux_structure to_host value)
                                 (-> (-> Any java/lang/Object) (Array java/lang/Object) LuxValue)
                                 (<| (ffi.is LuxValue)
                                     (ffi.object [] net/sandius/rembulan/impl/DefaultTable [LuxValue]
                                       []
                                       ... Methods
                                       (LuxValue
                                        [] (getValue self []) java/lang/Object
                                        (as java/lang/Object value))

                                       (net/sandius/rembulan/impl/DefaultTable
                                        [] (rawlen self []) long
                                        (|> value array.size .int ffi.as_long))

                                       (net/sandius/rembulan/impl/DefaultTable
                                        [] (rawget self [idx long]) java/lang/Object
                                        (|> value
                                            (array.item (|> idx ffi.of_long .nat --))
                                            maybe.trusted
                                            to_host))

                                       (net/sandius/rembulan/impl/DefaultTable
                                        [] (rawget self [field java/lang/Object])
                                        java/lang/Object
                                        (case (ffi.as net/sandius/rembulan/ByteString field)
                                          {.#Some field}
                                          (case (ffi.of_string (net/sandius/rembulan/ByteString::decode field))
                                            (pattern (static runtime.variant_tag_field))
                                            (case (array.item 0 value)
                                              {.#Some it}
                                              (|> it
                                                  (as java/lang/Integer)
                                                  (ffi.is java/lang/Object))

                                              {.#None}
                                              (undefined))
                                            
                                            (pattern (static runtime.variant_flag_field))
                                            (case (array.item 1 value)
                                              {.#Some _}
                                              (as java/lang/Object "")

                                              {.#None}
                                              (ffi.null))
                                            
                                            (pattern (static runtime.variant_value_field))
                                            (|> value
                                                (array.item 2)
                                                maybe.trusted
                                                to_host)

                                            "n"
                                            (|> value
                                                array.size
                                                .int
                                                ffi.as_long
                                                (ffi.is java/lang/Object))

                                            _
                                            (panic! (exception.error ..unknown_kind_of_object [(as java/lang/Object field)])))

                                          {.#None}
                                          (case (ffi.as java/lang/Long field)
                                            {.#Some idx}
                                            (case (array.item (|> idx ffi.of_long .nat --) value)
                                              {.#Some it}
                                              (to_host it)

                                              {.#None}
                                              (is java/lang/Object (ffi.null)))
                                            
                                            {.#None}
                                            (panic! (exception.error ..unknown_kind_of_object [(as java/lang/Object field)])))))
                                       )))

                               (exception: (cannot_apply_a_non_function [object java/lang/Object])
                                 (exception.report
                                  "Non-function" (ffi.of_string (java/lang/Object::toString object))))

                               (def: ensure_function
                                 (-> Macro (Maybe net/sandius/rembulan/runtime/LuaFunction))
                                 (|>> (as java/lang/Object)
                                      (ffi.as net/sandius/rembulan/runtime/LuaFunction)))

                               (type: Baggage
                                 [net/sandius/rembulan/StateContext
                                  net/sandius/rembulan/exec/DirectCallExecutor])

                               (def: (call_macro to_host [state_context executor] inputs lux macro)
                                 (-> (-> Any java/lang/Object) Baggage (List Code) Lux net/sandius/rembulan/runtime/LuaFunction (Try Any))
                                 (do try.monad
                                   [.let [inputs (is (ffi.type [java/lang/Object])
                                                     (|> (array.empty 2)
                                                         (array.has! 0 ... (as java/lang/Object inputs)
                                                                     ... (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new))
                                                                     (as java/lang/Object (lux_structure to_host (as (Array java/lang/Object) inputs))))
                                                         (array.has! 1 ... (as java/lang/Object lux)
                                                                     ... (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new))
                                                                     (as java/lang/Object (lux_structure to_host (as (Array java/lang/Object) lux))))))]
                                    output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context (as java/lang/Object macro) inputs executor)]
                                   (|> output
                                       (array.item 0)
                                       maybe.trusted
                                       (as java/lang/Object)
                                       ..read)))

                               (def: (expander to_host baggage macro inputs lux)
                                 (-> (-> Any java/lang/Object) Baggage Expander)
                                 (case (..ensure_function macro)
                                   {.#Some macro}
                                   (case (..call_macro to_host baggage inputs lux macro)
                                     {try.#Success output}
                                     (|> output
                                         (as (Try [Lux (List Code)]))
                                         {try.#Success})

                                     {try.#Failure error}
                                     {try.#Failure error})

                                   {.#None}
                                   (exception.except ..cannot_apply_a_non_function (as java/lang/Object macro)))))]
  (for @.old (these <jvm>)
       @.jvm (these <jvm>)

       @.lua
       (def: (expander macro inputs lux)
         Expander
         {try.#Success ((as Macro' macro) inputs lux)})))

(with_expansions [<jvm> (these (with_expansions [$var_args (_.var "...")
                                                 $str_rel_to_abs (_.var "_utf8_str_rel_to_abs")
                                                 $decode (_.var "_utf8_decode")]
                                 (local.let [!int (template (_ <hex>)
                                                    [(_.int (.int (hex <hex>)))])
                                             !&| (template (_ <or> <and> <raw>)
                                                   [(|> <raw>
                                                        (_.bit_and (!int <and>))
                                                        (_.bit_or (!int <or>)))])
                                             !&|< (template (_ <or> <and> <shift> <raw>)
                                                    [(|> <raw>
                                                         (_.bit_shr (_.int <shift>))
                                                         (_.bit_and (!int <and>))
                                                         (_.bit_or (!int <or>)))])]
                                   (these (def: rembulan//char
                                            (let [$buffer (_.var "buffer")
                                                  $k (_.var "k")
                                                  $v (_.var "v")
                                                  $b1 (_.var "b1")
                                                  $b2 (_.var "b2")
                                                  $b3 (_.var "b3")
                                                  $b4 (_.var "b4")
                                                  table/insert (function (_ in/0 in/1) (_.apply (list in/0 in/1) (_.var "table.insert")))]
                                              (_.function (_.var "utf8.char") (list $var_args)
                                                (all _.then
                                                     (_.local/1 $buffer (_.array (list)))
                                                     (<| (_.for_in (list $k $v) (_.ipairs/1 (_.array (list $var_args))))
                                                         (all _.then
                                                              (_.when (_.or (_.< (_.int +0) $v)
                                                                            (_.> (!int "10FFFF") $v))
                                                                      (_.statement (_.error/2 (|> (_.string "bad argument #")
                                                                                                  (_.concat $k)
                                                                                                  (_.concat (_.string " to char (out of range)")))
                                                                                              (_.int +2))))
                                                              (<| (_.if (_.< (!int "80") $v)
                                                                    ... Single-byte sequence
                                                                    (_.statement (|> (_.var "string.char")
                                                                                     (_.apply (list $v))
                                                                                     (table/insert $buffer))))
                                                                  (_.if (_.< (!int "800") $v)
                                                                    ... Two-byte sequence
                                                                    (_.statement (|> (_.var "string.char")
                                                                                     (_.apply (list (!&|< "C0" "1F" +6 $v)
                                                                                                    (!&| "80" "3F" $v)))
                                                                                     (table/insert $buffer))))
                                                                  (_.if (_.< (!int "10000") $v)
                                                                    ... Three-byte sequence
                                                                    (_.statement (|> (_.var "string.char")
                                                                                     (_.apply (list (!&|< "E0" "0F" +12 $v)
                                                                                                    (!&|< "80" "3F" +6 $v)
                                                                                                    (!&| "80" "3F" $v)))
                                                                                     (table/insert $buffer))))
                                                                  ... Four-byte sequence
                                                                  (_.statement (|> (_.var "string.char")
                                                                                   (_.apply (list (!&|< "F0" "07" +18 $v)
                                                                                                  (!&|< "80" "3F" +12 $v)
                                                                                                  (!&|< "80" "3F" +6 $v)
                                                                                                  (!&| "80" "3F" $v)))
                                                                                   (table/insert $buffer))))
                                                              ))
                                                     (_.return (_.apply (list $buffer (_.string "")) (_.var "table.concat")))
                                                     ))))

                                          ... (def: rembulan//str_rel_to_abs
                                          ...   (let [$string (_.var "string")
                                          ...         $args (_.var "args")
                                          ...         $k (_.var "k")
                                          ...         $v (_.var "v")]
                                          ...     (<| (_.local_function $str_rel_to_abs (list $string $var_args))
                                          ...         (all _.then
                                          ...             (_.local/1 $args (_.array (list $var_args)))
                                          ...             (<| (_.for_in (list $k $v) (_.ipairs/1 $args))
                                          ...                 (all _.then
                                          ...                     (_.if (_.> (_.int +0) $v)
                                          ...                       (_.set (list $v) $v)
                                          ...                       (_.set (list $v) (|> $v (_.+ (_.length $string)) (_.+ (_.int +1)))))
                                          ...                     (_.when (_.or (_.< (_.int +1) $v)
                                          ...                                   (_.> (_.length $string) $v))
                                          ...                             (_.statement (_.error/2 (_.string "bad index to string (out of range)") (_.int +3))))
                                          ...                     (_.set (list (_.nth $k $args)) $v)))
                                          ...             (_.return (_.apply (list $args) (_.var "table.unpack")))
                                          ...             ))))

                                          ... (def: rembulan//decode
                                          ...   (let [$string (_.var "string")
                                          ...         $start (_.var "start")
                                          ...         $b1 (_.var "b1")
                                          ...         $idx (_.var "idx")
                                          ...         $bx (_.var "bx")
                                          ...         $end (_.var "_end")]
                                          ...     (<| (_.local_function $decode (list $string $start))
                                          ...         (all _.then
                                          ...             (_.set (list $start) (_.apply (list $string (_.or (_.int +1) $start)) $str_rel_to_abs))
                                          ...             (_.local/1 $b1 (_.do "byte" (list $start $start) $string))
                                          ...             (<| (_.if (_.< (!int "80") $b1)
                                          ...                   ... Single-byte sequence
                                          ...                   (_.return (_.multi (list $start $start))))
                                          ...                 ... Validate first byte of multi-byte sequence
                                          ...                 (_.if (_.or (_.> (!int "F4") $b1)
                                          ...                             (_.< (!int "C2") $b1))
                                          ...                   (_.return _.nil))
                                          ...                 ... Get 'supposed' amount of continuation bytes from primary byte
                                          ...                 (all _.then
                                          ...                     (_.local/1 $end (|> (|> $b1 (_.>= (!int "F0")) (_.and (_.int +3)))
                                          ...                                         (_.or (|> $b1 (_.>= (!int "E0")) (_.and (_.int +2))))
                                          ...                                         (_.or (|> $b1 (_.>= (!int "C0")) (_.and (_.int +1))))
                                          ...                                         (_.+ $start)))
                                          ...                     ... Validate our continuation bytes
                                          ...                     (<| (_.for_in (list $idx $bx) (_.ipairs/1 (_.array (list (_.do "byte"
                                          ...                                                                                (list (_.+ (_.int +1) $start) $end)
                                          ...                                                                                $string)))))
                                          ...                         (_.when (|> $bx
                                          ...                                     (_.bit_and (!int "C0"))
                                          ...                                     (_.= (!int "80"))
                                          ...                                     _.not)
                                          ...                                 (_.return _.nil)))
                                          ...                     (_.return (_.multi (list $start $end)))
                                          ...                     ))
                                          ...             ))))

                                          ... (def: rembulan//codes
                                          ...   (let [$string (_.var "string")
                                          ...         $i (_.var "i")
                                          ...         $start (_.var "start")
                                          ...         $end (_.var "_end")]
                                          ...     (_.function (_.var "utf8.codes") (list $string)
                                          ...       (all _.then
                                          ...           (_.local/1 $i (_.int +1))
                                          ...           (_.return (<| (_.closure (list))
                                          ...                         (_.if (_.> (_.length $string) $i)
                                          ...                           (_.return _.nil)
                                          ...                           (all _.then
                                          ...                               (_.let (list $start $end) (_.apply (list $string $i) $decode))
                                          ...                               (_.if (_.not $start)
                                          ...                                 (_.statement (_.error/2 (_.string "invalid UTF-8 code") (_.int +2)))
                                          ...                                 (all _.then
                                          ...                                     (_.set (list $i) (_.+ (_.int +1) $end))
                                          ...                                     (_.return (_.multi (list $start (_.do "sub" (list $start $end) $string))))
                                          ...                                     ))
                                          ...                               ))))
                                          ...           ))))

                                          ... (def: rembulan//len
                                          ...   (let [$string (_.var "string")
                                          ...         $start (_.var "start")
                                          ...         $end (_.var "_end")
                                          ...         $seq_start (_.var "seq_start")
                                          ...         $seq_end (_.var "seq_end")
                                          ...         $size (_.var "size")]
                                          ...     (_.function (_.var "utf8.len") (list $string $start $end)
                                          ...       (all _.then
                                          ...           (_.set (list $start $end) (_.apply (list $string (_.or (_.int +1) $start) (_.or (_.int -1) $end)) $str_rel_to_abs))
                                          ...           (_.local/1 $size (_.int +0))
                                          ...           (_.repeat (_.>= $end $seq_end)
                                          ...                     (all _.then
                                          ...                         (_.let (list $seq_start $seq_end) (_.apply (list $string $start) $decode))
                                          ...                         (_.if (_.not $seq_start)
                                          ...                           ... Hit an invalid sequence!
                                          ...                           (_.return (_.multi (list (_.boolean false) $start)))
                                          ...                           (all _.then
                                          ...                               (_.set (list $start) (_.+ (_.int +1) $seq_end))
                                          ...                               (_.set (list $size) (_.+ (_.int +1) $size))
                                          ...                               ))
                                          ...                         ))
                                          ...           (_.return $size)
                                          ...           ))))
                                          
                                          ... (def: rembulan//charpattern
                                          ...   (_.set (list (_.var "utf8.charpattern"))
                                          ...          (_.string "[%z\x01-\x7F\xC2-\xF4][\x80-\xBF]*")))
                                          
                                          (def: rembulan_prelude
                                            _.Statement
                                            (all _.then
                                                 (_.function (_.var "os.time") (list)
                                                   (_.return (_.int +0)))

                                                 ... Ported from https://github.com/meepen/Lua-5.1-UTF-8
                                                 ..rembulan//char
                                                 ... ..rembulan//str_rel_to_abs
                                                 ... ..rembulan//decode
                                                 ... ..rembulan//codes
                                                 ... ..rembulan//len
                                                 ... ..rembulan//charpattern
                                                 )))))
                               
                               (def: host
                                 (IO [Baggage (Host _.Expression _.Statement)])
                                 (io (let [runtime_env (net/sandius/rembulan/env/RuntimeEnvironments::system)
                                           std_lib (net/sandius/rembulan/lib/StandardLibrary::in runtime_env)
                                           state_context (net/sandius/rembulan/impl/StateContexts::newDefaultInstance)
                                           table (net/sandius/rembulan/lib/StandardLibrary::installInto state_context std_lib)
                                           variable (net/sandius/rembulan/Variable::new table)
                                           loader (net/sandius/rembulan/compiler/CompilerChunkLoader::of (ffi.as_string "_lux_definition"))
                                           executor (net/sandius/rembulan/exec/DirectCallExecutor::newExecutor)
                                           scheduling_context (net/sandius/rembulan/exec/DirectCallExecutor::schedulingContextFactory executor)
                                           run! (is (-> _.Statement (Try Any))
                                                    (function (_ code)
                                                      (do try.monad
                                                        [lua_function (net/sandius/rembulan/load/ChunkLoader::loadTextChunk variable (ffi.as_string "lux compilation") (ffi.as_string (_.code code)) loader)
                                                         output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context (as java/lang/Object lua_function) (array.empty 0)
                                                                                                                    executor)]
                                                        (case (array.item 0 output)
                                                          {.#None}
                                                          (in [])

                                                          {.#Some value}
                                                          (read value)))))
                                           _ (try.trusted (run! ..rembulan_prelude))]
                                       [[state_context executor]
                                        (is (Host _.Expression _.Statement)
                                            (implementation
                                             (def: (evaluate context [_ code])
                                               (run! (_.return code)))
                                             
                                             (def: execute run!)
                                             
                                             (def: (define context custom [_ input])
                                               (let [global (maybe.else (reference.artifact context)
                                                                        custom)
                                                     @global (_.var global)
                                                     definition (_.set (list @global) input)]
                                                 (do try.monad
                                                   [_ (run! definition)
                                                    value (run! (_.return @global))]
                                                   (in [global value definition]))))

                                             (def: (ingest context content)
                                               (|> content
                                                   (at utf8.codec decoded)
                                                   try.trusted
                                                   (as _.Statement)))

                                             (def: (re_learn context custom content)
                                               (run! content))
                                             
                                             (def: (re_load context custom content)
                                               (do try.monad
                                                 [_ (run! content)]
                                                 (run! (_.return (_.var (reference.artifact context))))))))]))))]
  (for @.old (these <jvm>)
       @.jvm (these <jvm>)
       @.lua (these (ffi.import (load [ffi.String] "try" ffi.Function))
                    (def: host
                      (IO (Host _.Expression _.Statement))
                      (io (let [run! (is (-> _.Statement (Try Any))
                                         (function (_ code)
                                           (do try.monad
                                             [lua_function (..load (_.code code))]
                                             (let [output ("lua apply" lua_function)]
                                               {try.#Success (if ("lua object nil?" output)
                                                               []
                                                               output)}))))]
                            (is (Host _.Expression _.Statement)
                                (implementation
                                 (def: (evaluate! context [_ code])
                                   (run! (_.return code)))
                                 
                                 (def: execute! run!)
                                 
                                 (def: (define! context custom [_ input])
                                   (let [global (maybe.else (reference.artifact context)
                                                            custom)
                                         @global (_.var global)]
                                     (do try.monad
                                       [.let [definition (_.set (list @global) input)]
                                        _ (run! definition)
                                        value (run! (_.return @global))]
                                       (in [global value definition]))))

                                 (def: (ingest context content)
                                   (|> content (at utf8.codec decoded) try.trusted (as _.Statement)))

                                 (def: (re_learn context custom content)
                                   (run! content))
                                 
                                 (def: (re_load context custom content)
                                   (do try.monad
                                     [_ (run! content)]
                                     (run! (_.return (_.var (reference.artifact context))))))))))))))

(with_expansions [<jvm> (these (def: (to_host it)
                                 (-> Any java/lang/Object)
                                 (`` (<| (~~ (with_template [<jvm> <lua>]
                                               [(case (ffi.as <jvm> (as java/lang/Object it))
                                                  {.#Some it}
                                                  (as java/lang/Object
                                                      (<lua> [(as_expected it)]))

                                                  {.#None})]

                                               [[java/lang/Object] (..lux_structure to_host)]
                                               [library/lux/Function (..lua_function to_host)]
                                               ))
                                         (as java/lang/Object it))))

                               (def: (extender [state_context executor] phase_wrapper)
                                 (-> Baggage (-> phase.Wrapper Extender))
                                 ... TODO: Stop relying on coercions ASAP.
                                 (<| (as Extender)
                                     (function (@self handler))
                                     (as Handler)
                                     (function (@self name phase))
                                     (as Phase)
                                     (function (@self archive parameters))
                                     (as Operation)
                                     (function (@self state))
                                     (as Try)
                                     try.trusted
                                     (as Try)
                                     (do try.monad
                                       [handler (try.of_maybe (..ensure_function handler))
                                        output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context
                                                                                                   (as java/lang/Object handler)
                                                                                                   (|> (array.empty 5)
                                                                                                       (array.has! 0 name)
                                                                                                       (array.has! 1 (as java/lang/Object (phase_wrapper phase)))
                                                                                                       (array.has! 2 (..to_host archive))
                                                                                                       (array.has! 3 (..to_host parameters))
                                                                                                       (array.has! 4 (..to_host state)))
                                                                                                   executor)]
                                       (|> output
                                           (array.item 0)
                                           maybe.trusted
                                           (as java/lang/Object)
                                           ..read)))))]
  (for @.old (these <jvm>)
       @.jvm (these <jvm>)

       @.lua
       (def: (extender phase_wrapper handler)
         (-> phase.Wrapper Extender)
         (as_expected handler))))

(def: (phase_wrapper archive)
  (-> Archive (runtime.Operation phase.Wrapper))
  (do phase.monad
    []
    (in (as phase.Wrapper
            (for @.old (..lua_function ..to_host)
                 @.jvm (..lua_function ..to_host)
                 @.lua (|>>))))))

(with_expansions [<jvm> (def: platform
                          (IO [Baggage (Platform [Register _.Label] _.Expression _.Statement)])
                          (do io.monad
                            [[baggage host] ..host]
                            (in [baggage
                                 [platform.#file_system (file.async file.default)
                                  platform.#host host
                                  platform.#phase lua.generate
                                  platform.#runtime runtime.generate
                                  platform.#phase_wrapper ..phase_wrapper
                                  platform.#write (|>> _.code (at utf8.codec encoded))]])))]
  (for @.old <jvm>
       @.jvm <jvm>
       @.lua (def: platform
               (IO (Platform [Register _.Label] _.Expression _.Statement))
               (do io.monad
                 [host ..host]
                 (in [platform.#file_system (file.async file.default)
                      platform.#host host
                      platform.#phase lua.generate
                      platform.#runtime runtime.generate
                      platform.#phase_wrapper ..phase_wrapper
                      platform.#write (|>> _.code (at utf8.codec encoded))])))))

(def: (program context program)
  (Program _.Expression _.Statement)
  (let [$program (_.var (reference.artifact context))]
    (_.statement (_.apply (list (runtime.lux//program_args (_.var "arg"))
                                runtime.unit)
                          program))))

(def: (declare_success! _)
  (-> Any (Async Any))
  (async.future (at world/program.default exit +0)))

(def: (lux_compiler it)
  (-> Any platform.Custom)
  (undefined))

(`` (program: [service cli.service]
      (let [context (context.lua (cli.target service))]
        (do io.monad
          [(~~ (for @.old [baggage platform]
                    @.jvm [baggage platform]
                    @.lua platform))
           ..platform]
          (exec (do async.monad
                  [_ (/.compiler ..lux_compiler
                                 context
                                 (for @.old (..expander ..to_host baggage)
                                      @.jvm (..expander ..to_host baggage)
                                      @.lua ..expander)
                                 analysis.bundle
                                 (io.io platform)
                                 generation.bundle
                                 (function.constant extension/bundle.empty)
                                 ..program
                                 [(type [Register _.Label])
                                  _.Expression
                                  _.Statement]
                                 (for @.old (..extender baggage)
                                      @.jvm (..extender baggage)
                                      @.lua ..extender)
                                 service
                                 [(packager.package (_.manual "")
                                                    _.code
                                                    _.then
                                                    (|>>))
                                  (format (cli.target service)
                                          (at file.default separator)
                                          "program"
                                          (the context.#artifact_extension context))])]
                  (..declare_success! []))
            (io.io []))))))