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

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

(with_expansions [<jvm> (as_is (ffi.import: java/lang/String)

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

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

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

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

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

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

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

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

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

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

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

                               (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" (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>]))
                                        ["[1]::[0]"
                                         (getValue [] java/lang/Object)]))]

                                 [StructureValue]
                                 )

                               (def: (lux_structure value)
                                 (-> (Array java/lang/Object) program/StructureValue)
                                 (let [re_wrap (: (-> java/lang/Object java/lang/Object)
                                                  (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)))]
                                   (:as program/StructureValue
                                        (ffi.object [] net/sandius/rembulan/impl/DefaultTable [program/StructureValue]
                                          []
                                          ... Methods
                                          (program/StructureValue
                                           [] (getValue self []) java/lang/Object
                                           (:as 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) --)) maybe.trusted 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.trusted)
                                               
                                               (^ (static runtime.variant_flag_field))
                                               (case (array.read! 1 value)
                                                 {#.Some _}
                                                 (:as java/lang/Object "")

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

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

                                             #.None
                                             (case (ffi.check java/lang/Long field)
                                               {#.Some idx}
                                               (|> value (array.read! (|> idx (:as Nat) --)) maybe.trusted re_wrap)
                                               
                                               #.None
                                               (panic! (exception.error ..unknown_kind_of_object [(:as java/lang/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 (: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 [(: Any (|> tag (:as java/lang/Long) java/lang/Long::intValue))
                                                  (: Any (case ?flag
                                                           {#.Some _} (: Any "")
                                                           #.None (:as Any (ffi.null))))
                                                  (: 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 (net/sandius/rembulan/Table::rawlen host_object))]
                                   (loop [num_keys init_num_keys
                                          idx 0
                                          output (: (Array java/lang/Object)
                                                    (array.empty init_num_keys))]
                                     (if (n.< num_keys idx)
                                       (case (net/sandius/rembulan/Table::get_idx (:as java/lang/Long (++ idx)) host_object)
                                         #.None
                                         (recur num_keys (++ idx) output)

                                         {#.Some member}
                                         (case (read member)
                                           {#try.Success parsed_member}
                                           (recur num_keys (++ idx) (array.write! 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 []))
                                         (~~ (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.except ..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.empty 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.trusted (: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.except ..cannot_apply_a_non_function (:as java/lang/Object macro)))))]
  (for [@.old (as_is <jvm>)
        @.jvm (as_is <jvm>)

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

(with_expansions [<jvm> (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.empty 0)
                                                                                                                   executor)]
                                                       (case (array.read! 0 output)
                                                         #.None
                                                         (in [])

                                                         {#.Some value}
                                                         (read value)))))
                                           _ (try.trusted (run! ..rembulan_prelude))]
                                       [[state_context executor]
                                        (: (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 (\ 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 (as_is <jvm>)
        @.jvm (as_is <jvm>)
        @.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 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 (\ 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> (as_is (exception: .public (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.trusted
                                        (do try.monad
                                          [input/0 (..read input/0)]
                                          (case partial_application
                                            (^ (list partial/0 partial/1))
                                            (in (..to_host ((:as (-> Any Any Any Any) phase)
                                                            partial/0
                                                            partial/1
                                                            input/0)))

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

                                            _
                                            (exception.except ..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.trusted
                                        (do try.monad
                                          [input/0 (..read input/0)
                                           input/1 (..read input/1)]
                                          (case partial_application
                                            (^ (list partial/0))
                                            (in (..to_host ((:as (-> Any Any Any Any) phase)
                                                            partial/0
                                                            input/0
                                                            input/1)))
                                            
                                            (^ (list))
                                            (in (host_phase (list input/0 input/1) phase))

                                            _
                                            (exception.except ..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.trusted
                                        (do try.monad
                                          [input/0 (..read input/0)
                                           input/1 (..read input/1)
                                           input/2 (..read input/2)]
                                          (case partial_application
                                            (^ (list))
                                            (in (..to_host ((:as (-> Any Any Any Any) phase)
                                                            input/0
                                                            input/1
                                                            input/2)))
                                            
                                            _
                                            (exception.except ..invaid_phase_application [partial_application 3])))))))

                               (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.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.trusted
                                           (:as java/lang/Object)
                                           ..read)))))]
  (for [@.old (as_is <jvm>)
        @.jvm (as_is <jvm>)

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

(def: (phase_wrapper archive)
  (-> Archive (runtime.Operation phase.Wrapper))
  (do phase.monad
    []
    (in (:as phase.Wrapper
             (for [@.old (..host_phase (list))
                   @.jvm (..host_phase (list))
                   @.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 (\ 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 (\ 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 (\ world/program.default exit +0)))

(`` (program: [service /cli.service]
      (let [extension ".lua"]
        (do io.monad
          [(~~ (for [@.old [baggage platform]
                     @.jvm [baggage platform]
                     @.lua platform]))
           ..platform]
          (exec (do async.monad
                  [_ (/.compiler [#/static.host @.lua
                                  #/static.host_module_extension extension
                                  #/static.target (/cli.target service)
                                  #/static.artifact_extension extension]
                                 (for [@.old (..expander baggage)
                                       @.jvm (..expander 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)
                                          (\ file.default separator)
                                          "program"
                                          extension)])]
                  (..declare_success! []))
            (io.io []))))))