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

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

(for {@.old
      (as_is (ffi.import: java/lang/String)

             (ffi.import: (java/lang/Class a))

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

             (ffi.import: java/lang/Long
               ["#::."
                (intValue [] java/lang/Integer)])

             (ffi.import: net/sandius/rembulan/StateContext)

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

             (ffi.import: net/sandius/rembulan/env/RuntimeEnvironment)

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

             (ffi.import: net/sandius/rembulan/Table
               ["#::."
                (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
               ["#::."
                (decode [] java/lang/String)])

             (ffi.import: net/sandius/rembulan/impl/DefaultTable)

             (ffi.import: net/sandius/rembulan/impl/ImmutableTable)

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

             (ffi.import: net/sandius/rembulan/lib/StandardLibrary
               ["#::."
                (#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
               ["#::."
                (new [java/lang/Object])])

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

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

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

             (ffi.import: net/sandius/rembulan/runtime/SchedulingContext)

             (ffi.import: net/sandius/rembulan/runtime/SchedulingContextFactory)

             (ffi.import: net/sandius/rembulan/exec/DirectCallExecutor
               ["#::."
                (#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" (java/lang/Object::toString (java/lang/Object::getClass object))]
                ["Object" (java/lang/Object::toString object)]))

             (template [<name>]
               [(ffi.interface: <name>
                  (getValue [] java/lang/Object))

                (`` (ffi.import: (~~ (template.identifier ["program/" <name>]))
                      ["#::."
                       (getValue [] java/lang/Object)]))]

               [StructureValue]
               )

             (def: (lux_structure value)
               (-> (Array java/lang/Object) program/StructureValue)
               (let [re_wrap (function (_ unwrapped)
                               (case (ffi.check [java/lang/Object] unwrapped)
                                 (#.Some sub_value)
                                 (|> sub_value (:as (Array java/lang/Object)) lux_structure (:as java/lang/Object))
                                 
                                 #.None
                                 unwrapped))]
                 (ffi.object [] net/sandius/rembulan/impl/DefaultTable [program/StructureValue]
                   []
                   ## Methods
                   (program/StructureValue
                    [] (getValue self) java/lang/Object
                    (:as (Array java/lang/Object) value))

                   (net/sandius/rembulan/impl/DefaultTable
                    [] (rawlen self) long
                    (|> value array.size (:as java/lang/Long)))

                   (net/sandius/rembulan/impl/DefaultTable
                    [] (rawget self {idx long}) java/lang/Object
                    (|> value (array.read (|> idx (:as Nat) dec)) maybe.assume re_wrap))

                   (net/sandius/rembulan/impl/DefaultTable
                    [] (rawget self {field java/lang/Object}) java/lang/Object
                    (case (ffi.check net/sandius/rembulan/ByteString field)
                      (#.Some field)
                      (case (net/sandius/rembulan/ByteString::decode field)
                        (^ (static runtime.variant_tag_field))
                        (|> value (array.read 0) maybe.assume)
                        
                        (^ (static runtime.variant_flag_field))
                        (case (array.read 1 value)
                          (#.Some _)
                          ""

                          #.None
                          (ffi.null))
                        
                        (^ (static runtime.variant_value_field))
                        (|> value (array.read 2) maybe.assume re_wrap)

                        _
                        (error! (exception.construct ..unknown_kind_of_object field)))

                      #.None
                      (case (ffi.check java/lang/Long field)
                        (#.Some idx)
                        (|> value (array.read (|> idx (:as Nat) dec)) maybe.assume re_wrap)
                        
                        #.None
                        (error! (exception.construct ..unknown_kind_of_object field)))))
                   )))

             (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 runtime.variant_tag_field host_object)
                      (net/sandius/rembulan/Table::get_key runtime.variant_flag_field host_object)
                      (net/sandius/rembulan/Table::get_key runtime.variant_value_field host_object)]
                 (^multi [(#.Some tag) ?flag (#.Some value)]
                         [(read value)
                          (#.Some value)])
                 (#try.Success [(java/lang/Long::intValue (:as java/lang/Long tag))
                                (: Any (case ?flag (#.Some _) "" #.None (ffi.null)))
                                value])

                 _
                 (exception.throw ..unknown_kind_of_object host_object)))

             (def: (read_tuple read host_object)
               (-> Translator net/sandius/rembulan/impl/DefaultTable (Try Any))
               (let [init_num_keys (.nat (net/sandius/rembulan/Table::rawlen host_object))]
                 (loop [num_keys init_num_keys
                        idx 0
                        output (: (Array java/lang/Object)
                                  (array.new init_num_keys))]
                   (if (n.< num_keys idx)
                     (case (net/sandius/rembulan/Table::get_idx (:as java/lang/Long (inc idx)) host_object)
                       #.None
                       (recur num_keys (inc idx) output)

                       (#.Some member)
                       (case (read member)
                         (#try.Success parsed_member)
                         (recur num_keys (inc idx) (array.write! idx (:as java/lang/Object parsed_member) output))

                         (#try.Failure error)
                         (#try.Failure error)))
                     (#try.Success output)))))

             (exception: #export nil_has_no_lux_representation)

             (def: (read host_object)
               Translator
               (`` (<| (if (ffi.null? host_object)
                         (exception.throw ..nil_has_no_lux_representation []))
                       (~~ (template [<class> <post_processing>]
                             [(case (ffi.check <class> host_object)
                                (#.Some typed_object)
                                (|> typed_object <post_processing>)

                                _)]

                             [java/lang/Boolean #try.Success]
                             [java/lang/Long #try.Success]
                             [java/lang/Double #try.Success]
                             [java/lang/String #try.Success]
                             [net/sandius/rembulan/runtime/LuaFunction #try.Success]
                             [net/sandius/rembulan/ByteString (<| #try.Success net/sandius/rembulan/ByteString::decode)]
                             [program/StructureValue (<| #try.Success program/StructureValue::getValue)]
                             ))
                       (case (ffi.check net/sandius/rembulan/impl/DefaultTable host_object)
                         (#.Some typed_object)
                         (case (read_variant read typed_object)
                           (#try.Success value)
                           (#try.Success value)

                           (#try.Failure error)
                           (read_tuple read typed_object))

                         _)
                       (exception.throw ..unknown_kind_of_object host_object)
                       )))

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

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

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

             (def: (call_macro [state_context executor] inputs lux macro)
               (-> Baggage (List Code) Lux net/sandius/rembulan/runtime/LuaFunction (Try Any))
               (do try.monad
                 [output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context
                                                                             (:as java/lang/Object macro)
                                                                             (|> (array.new 2)
                                                                                 (array.write! 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 (:as (Array java/lang/Object) inputs))))
                                                                                 (array.write! 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 (:as (Array java/lang/Object) lux)))))
                                                                             executor)]
                 (|> output (array.read 0) maybe.assume (:as java/lang/Object) ..read)))

             (def: (expander baggage macro inputs lux)
               (-> Baggage Expander)
               (case (..ensure_function macro)
                 (#.Some macro)
                 (case (..call_macro baggage inputs lux macro)
                   (#try.Success output)
                   (|> output
                       (:as (Try [Lux (List Code)]))
                       #try.Success)

                   (#try.Failure error)
                   (#try.Failure error))

                 #.None
                 (exception.throw ..cannot_apply_a_non_function (:as java/lang/Object macro)))))

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

(for {@.old (as_is (with_expansions [$var_args (_.var "...")
                                     $str_rel_to_abs (_.var "_utf8_str_rel_to_abs")
                                     $decode (_.var "_utf8_decode")]
                     (template.let [(!int <hex>)
                                    [(_.int (.int (hex <hex>)))]

                                    (!&| <or> <and> <raw>)
                                    [(|> <raw>
                                         (_.bit_and (!int <and>))
                                         (_.bit_or (!int <or>)))]
                                    
                                    (!&|< <or> <and> <shift> <raw>)
                                    [(|> <raw>
                                         (_.bit_shr (_.int <shift>))
                                         (_.bit_and (!int <and>))
                                         (_.bit_or (!int <or>)))]]
                       (as_is (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 (_.apply/2 (_.var "table.insert"))]
                                  (_.function (_.var "utf8.char") (list $var_args)
                                    ($_ _.then
                                        (_.local/1 $buffer (_.array (list)))
                                        (<| (_.for_in (list $k $v) (_.ipairs/1 (_.array (list $var_args))))
                                            ($_ _.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/2 (_.var "table.concat") $buffer (_.string "")))
                                        ))))

                              ## (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))
                              ##         ($_ _.then
                              ##             (_.local/1 $args (_.array (list $var_args)))
                              ##             (<| (_.for_in (list $k $v) (_.ipairs/1 $args))
                              ##                 ($_ _.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/1 (_.var "table.unpack") $args))
                              ##             ))))

                              ## (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))
                              ##         ($_ _.then
                              ##             (_.set (list $start) (_.apply/2 $str_rel_to_abs $string (_.or (_.int +1) $start)))
                              ##             (_.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
                              ##                 ($_ _.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)
                              ##       ($_ _.then
                              ##           (_.local/1 $i (_.int +1))
                              ##           (_.return (<| (_.closure (list))
                              ##                         (_.if (_.> (_.length $string) $i)
                              ##                           (_.return _.nil)
                              ##                           ($_ _.then
                              ##                               (_.let (list $start $end) (_.apply/2 $decode $string $i))
                              ##                               (_.if (_.not $start)
                              ##                                 (_.statement (_.error/2 (_.string "invalid UTF-8 code") (_.int +2)))
                              ##                                 ($_ _.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)
                              ##       ($_ _.then
                              ##           (_.set (list $start $end) (_.apply/3 $str_rel_to_abs $string (_.or (_.int +1) $start) (_.or (_.int -1) $end)))
                              ##           (_.local/1 $size (_.int +0))
                              ##           (_.repeat (_.>= $end $seq_end)
                              ##                     ($_ _.then
                              ##                         (_.let (list $seq_start $seq_end) (_.apply/2 $decode $string $start))
                              ##                         (_.if (_.not $seq_start)
                              ##                           ## Hit an invalid sequence!
                              ##                           (_.return (_.multi (list (_.bool false) $start)))
                              ##                           ($_ _.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
                                ($_ _.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 "_lux_definition")
                               executor (net/sandius/rembulan/exec/DirectCallExecutor::newExecutor)
                               scheduling_context (net/sandius/rembulan/exec/DirectCallExecutor::schedulingContextFactory executor)
                               run! (: (-> _.Statement (Try Any))
                                       (function (_ code)
                                         (do try.monad
                                           [lua_function (net/sandius/rembulan/load/ChunkLoader::loadTextChunk variable "lux compilation" (_.code code) loader)
                                            output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context (:as java/lang/Object lua_function) (array.new 0)
                                                                                                       executor)]
                                           (case (array.read 0 output)
                                             #.None
                                             (wrap [])

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

                                (def: (ingest context content)
                                  (|> content (\ utf8.codec decode) try.assume (:as _.Statement)))

                                (def: (re_learn context content)
                                  (run! content))
                                
                                (def: (re_load context content)
                                  (do try.monad
                                    [_ (run! content)]
                                    (run! (_.return (_.var (reference.artifact context))))))))]))))
      @.lua (as_is (ffi.import: (load [ffi.String] #try ffi.Function))
                   (def: host
                     (IO (Host _.Expression _.Statement))
                     (io (let [run! (: (-> _.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))))))]
                           (: (Host _.Expression _.Statement)
                              (implementation
                               (def: (evaluate! context code)
                                 (run! (_.return code)))
                               
                               (def: execute! run!)
                               
                               (def: (define! context input)
                                 (let [global (reference.artifact context)
                                       @global (_.var global)]
                                   (do try.monad
                                     [#let [definition (_.set (list @global) input)]
                                      _ (run! definition)
                                      value (run! (_.return @global))]
                                     (wrap [global value definition]))))

                               (def: (ingest context content)
                                 (|> content (\ utf8.codec decode) try.assume (:as _.Statement)))

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

(for {@.old
      (as_is (exception: #export (invaid_phase_application {partial_application (List Any)}
                                                           {arity Nat})
               (exception.report
                ["Partial Application" (%.nat (list.size partial_application))]
                ["Arity" (%.nat arity)]))

             (def: to_host
               (-> Any java/lang/Object)
               (|>> (:as (Array java/lang/Object)) ..lux_structure (:as java/lang/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: (host_phase partial_application phase)
               (All [s i o]
                 (-> (List Any) (Phase [extension.Bundle s] i o)
                     java/lang/Object))
               (ffi.object [] net/sandius/rembulan/runtime/LuaFunction []
                 []
                 ## Methods
                 (net/sandius/rembulan/runtime/LuaFunction
                  [] (invoke self
                             {% net/sandius/rembulan/runtime/ExecutionContext})
                  void
                  (<| (..return %)
                      (host_phase partial_application phase)))

                 (net/sandius/rembulan/runtime/LuaFunction
                  [] (invoke self
                             {% net/sandius/rembulan/runtime/ExecutionContext}
                             {input/0 java/lang/Object})
                  void
                  (<| (..return %)
                      try.assume
                      (do try.monad
                        [input/0 (..read input/0)]
                        (case partial_application
                          (^ (list partial/0 partial/1))
                          (wrap (..to_host ((:as (-> Any Any Any Any) phase)
                                            partial/0
                                            partial/1
                                            input/0)))

                          (^ (list partial/0))
                          (wrap (host_phase (list partial/0 input/0) phase))
                          
                          (^ (list))
                          (wrap (host_phase (list input/0) phase))

                          _
                          (exception.throw ..invaid_phase_application [partial_application 2])))))

                 (net/sandius/rembulan/runtime/LuaFunction
                  [] (invoke self
                             {% net/sandius/rembulan/runtime/ExecutionContext}
                             {input/0 java/lang/Object}
                             {input/1 java/lang/Object})
                  void
                  (<| (..return %)
                      try.assume
                      (do try.monad
                        [input/0 (..read input/0)
                         input/1 (..read input/1)]
                        (case partial_application
                          (^ (list partial/0))
                          (wrap (..to_host ((:as (-> Any Any Any Any) phase)
                                            partial/0
                                            input/0
                                            input/1)))
                          
                          (^ (list))
                          (wrap (host_phase (list input/0 input/1) phase))

                          _
                          (exception.throw ..invaid_phase_application [partial_application 2])))))

                 (net/sandius/rembulan/runtime/LuaFunction
                  [] (invoke self
                             {% net/sandius/rembulan/runtime/ExecutionContext}
                             {input/0 java/lang/Object}
                             {input/1 java/lang/Object}
                             {input/2 java/lang/Object})
                  void
                  (<| (..return %)
                      try.assume
                      (do try.monad
                        [input/0 (..read input/0)
                         input/1 (..read input/1)
                         input/2 (..read input/2)]
                        (case partial_application
                          (^ (list))
                          (wrap (..to_host ((:as (-> Any Any Any Any) phase)
                                            input/0
                                            input/1
                                            input/2)))
                          
                          _
                          (exception.throw ..invaid_phase_application [partial_application 3])))))))

             (def: (extender [state_context executor] phase_wrapper)
               (-> Baggage (-> platform.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.assume
                   (:as Try)
                   (do try.monad
                     [handler (try.from_maybe (..ensure_function handler))
                      output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context
                                                                                 (:as java/lang/Object handler)
                                                                                 (|> (array.new 5)
                                                                                     (array.write! 0 name)
                                                                                     (array.write! 1 (:as java/lang/Object (phase_wrapper phase)))
                                                                                     (array.write! 2 (..to_host archive))
                                                                                     (array.write! 3 (..to_host parameters))
                                                                                     (array.write! 4 (..to_host state)))
                                                                                 executor)]
                     (|> output
                         (array.read 0)
                         maybe.assume
                         (:as java/lang/Object)
                         ..read)))))

      @.lua
      (def: (extender phase_wrapper handler)
        (-> platform.Phase_Wrapper Extender)
        (:assume handler))})

(def: (phase_wrapper archive)
  (-> Archive (runtime.Operation platform.Phase_Wrapper))
  (do phase.monad
    []
    (wrap (:as platform.Phase_Wrapper
               (for {@.old (..host_phase (list))
                     @.lua (|>>)})))))

(for {@.old (def: platform
              (IO [Baggage (Platform [Register _.Label] _.Expression _.Statement)])
              (do io.monad
                [[baggage host] ..host]
                (wrap [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 (\ utf8.codec encode))}])))
      @.lua (def: platform
              (IO (Platform [Register _.Label] _.Expression _.Statement))
              (do io.monad
                [host ..host]
                (wrap {#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 (\ utf8.codec encode))})))})

(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 (Promise Any))
  (promise.future (\ world/program.default exit +0)))

(`` (program: [{service /cli.service}]
      (let [extension ".lua"]
        (do io.monad
          [(~~ (for {@.old [baggage platform]
                     @.lua platform}))
           ..platform]
          (exec (do promise.monad
                  [_ (/.compiler {#/static.host @.lua
                                  #/static.host_module_extension extension
                                  #/static.target (/cli.target service)
                                  #/static.artifact_extension extension}
                                 (for {@.old (..expander baggage)
                                       @.lua ..expander})
                                 analysis.bundle
                                 (io.io platform)
                                 generation.bundle
                                 (function.constant extension/bundle.empty)
                                 ..program
                                 [(& Register _.Label) _.Expression _.Statement]
                                 (for {@.old (..extender baggage)
                                       @.lua ..extender})
                                 service
                                 [(packager.package (_.manual "")
                                                    _.code
                                                    _.then
                                                    (|>>))
                                  (format (/cli.target service)
                                          (\ file.default separator)
                                          "program"
                                          extension)])]
                  (..declare_success! []))
            (io.io []))))))