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

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

(import: java/lang/String)

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

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

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

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

(import: org/jruby/RubyString
  ["#::."
   (#static newInternalFromJavaExternal [org/jruby/Ruby java/lang/String] org/jruby/RubyString)
   (asJavaString [] java/lang/String)])

(import: org/jruby/RubySymbol
  ["#::."
   (asJavaString [] java/lang/String)])

(import: org/jruby/runtime/builtin/IRubyObject)

(import: org/jruby/Ruby
  ["#::."
   (getCurrentContext [] org/jruby/runtime/ThreadContext)
   (getNil [] org/jruby/runtime/builtin/IRubyObject)])

(import: org/jruby/RubyClass)

(import: org/jruby/RubyArray
  ["#::."
   (getLength [] int)
   (get [int] #? Object)])

(import: org/jruby/RubyHash
  ["#::."
   (get [java/lang/Object] #? java/lang/Object)])

(import: org/jruby/runtime/ThreadContext)

(import: org/jruby/RubyRange
  ["#::."
   (first [org/jruby/runtime/ThreadContext] org/jruby/runtime/builtin/IRubyObject)
   (size [org/jruby/runtime/ThreadContext] org/jruby/runtime/builtin/IRubyObject)])

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

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

  [StructureValue]
  )

(syntax: (method_inputs {input_classes (<code>.tuple (<>.some <code>.any))})
  (monad.map meta.monad
             (function (_ class)
               (do meta.monad
                 [var (macro.gensym "input")]
                 (wrap (code.record (list [var class])))))
             input_classes))

(import: org/jruby/runtime/JavaSites$CheckedSites)
(import: org/jruby/runtime/builtin/Variable)
(import: org/jruby/runtime/builtin/InstanceVariables)
(import: org/jruby/runtime/builtin/InternalVariables)

(import: org/jruby/embed/internal/LocalContextProvider
  ["#::."
   (getRuntime [] org/jruby/Ruby)])

(import: org/jruby/embed/ScriptingContainer
  ["#::."
   (new [])
   (runScriptlet [java/lang/String] #try #? java/lang/Object)
   (getProvider [] org/jruby/embed/internal/LocalContextProvider)])

## TODO; Figure out a way to not need "interpreter" to be a global variable.
(def: interpreter
  (org/jruby/embed/ScriptingContainer::new))

(template: (!ruby_runtime)
  (|> ..interpreter
      org/jruby/embed/ScriptingContainer::getProvider
      org/jruby/embed/internal/LocalContextProvider::getRuntime))

(template: (!ruby_thread_context)
  (|> (!ruby_runtime)
      org/jruby/Ruby::getCurrentContext))

(def: initial_ruby_runtime
  (!ruby_runtime))

(import: org/jruby/java/proxies/JavaProxy
  ["#::."
   (new [org/jruby/Ruby org/jruby/RubyClass java/lang/Object])
   (getObject [] java/lang/Object)])

(import: org/jruby/internal/runtime/methods/DynamicMethod)

(import: org/jruby/runtime/callsite/CacheEntry
  ["#::."
   (new [org/jruby/internal/runtime/methods/DynamicMethod int])])

(import: org/jruby/RubyFixnum
  ["#::."
   (new [org/jruby/Ruby long])
   (getLongValue [] long)])

(import: org/jruby/RubyFloat
  ["#::."
   (new [org/jruby/Ruby double])])

(import: org/jruby/RubyBoolean
  ["#::."
   (#static newBoolean [org/jruby/Ruby boolean] org/jruby/RubyBoolean)])

(import: org/jruby/RubyNil
  ["#::."
   (new [org/jruby/Ruby])])

(import: org/jruby/runtime/Block$Type
  ["#::."
   (#enum PROC)])

(import: org/jruby/runtime/Signature
  ["#::."
   (#static THREE_ARGUMENTS org/jruby/runtime/Signature)])

(import: org/jruby/parser/StaticScope)

(import: org/jruby/parser/StaticScopeFactory
  ["#::."
   (new [org/jruby/Ruby])
   (getDummyScope [] org/jruby/parser/StaticScope)])

(import: org/jruby/runtime/BlockBody)

(import: org/jruby/runtime/Block
  ["#::."
   (#static NULL_BLOCK org/jruby/runtime/Block)
   (type org/jruby/runtime/Block$Type)
   (getBody [] org/jruby/runtime/BlockBody)])

(import: org/jruby/RubyProc
  ["#::."
   (#static newProc [org/jruby/Ruby org/jruby/runtime/Block org/jruby/runtime/Block$Type] org/jruby/RubyProc)
   (call [org/jruby/runtime/ThreadContext [org/jruby/runtime/builtin/IRubyObject]]
         #try org/jruby/runtime/builtin/IRubyObject)])

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

(def: (read_tuple read host_object)
  (-> Translator org/jruby/RubyArray (Try Any))
  (let [size (:as Nat (org/jruby/RubyArray::getLength host_object))]
    (loop [idx 0
           output (:as (Array Any) (array.new size))]
      (if (n.< size idx)
        (case (org/jruby/RubyArray::get (.int idx) host_object)
          #.None
          (recur (inc idx) output)
          
          (#.Some value)
          (case (read value)
            (#try.Failure error)
            (#try.Failure error)

            (#try.Success lux_value)
            (recur (inc idx) (array.write! idx lux_value output))))
        (#try.Success output)))))

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

(def: (read_variant read host_object)
  (-> Translator org/jruby/RubyHash (Try Any))
  (case [(org/jruby/RubyHash::get runtime.variant_tag_field host_object)
         (org/jruby/RubyHash::get runtime.variant_flag_field host_object)
         (org/jruby/RubyHash::get 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])))

(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 (~~ (template.splice <post_processing>))))

                   _)]

                [java/lang/Boolean [#try.Success]]
                [java/lang/Long [#try.Success]]
                [java/lang/Double [#try.Success]]
                [java/lang/String [#try.Success]]
                [[java/lang/Object] [#try.Success]]
                [org/jruby/RubyArray [(read_tuple read)]]
                [org/jruby/RubyHash [(read_variant read)]]
                [org/jruby/RubySymbol [#try.Success]]
                [org/jruby/RubyProc [#try.Success]]
                [org/jruby/java/proxies/JavaProxy [org/jruby/java/proxies/JavaProxy::getObject #try.Success]]
                ))
          (exception.throw ..unknown_kind_of_object [host_object])
          )))

(def: ruby_nil
  org/jruby/runtime/builtin/IRubyObject
  (org/jruby/Ruby::getNil ..initial_ruby_runtime))

(def: lux_unit
  org/jruby/RubyString
  (org/jruby/RubyString::newInternalFromJavaExternal ..initial_ruby_runtime ""))

(def: (wrapped_lux_value lux_structure value)
  (-> (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject)
      (-> java/lang/Object org/jruby/runtime/builtin/IRubyObject))
  (<| (case (ffi.check [java/lang/Object] value)
        (#.Some value)
        (|> value (:as (Array java/lang/Object)) lux_structure)

        #.None)
      (case (ffi.check java/lang/Boolean value)
        (#.Some value)
        (org/jruby/RubyBoolean::newBoolean ..initial_ruby_runtime value)
        
        #.None)
      (case (ffi.check java/lang/Long value)
        (#.Some value)
        (org/jruby/RubyFixnum::new ..initial_ruby_runtime value)
        
        #.None)
      (case (ffi.check java/lang/Double value)
        (#.Some value)
        (org/jruby/RubyFloat::new ..initial_ruby_runtime value)
        
        #.None)
      (case (ffi.check java/lang/String value)
        (#.Some value)
        (org/jruby/RubyString::newInternalFromJavaExternal ..initial_ruby_runtime value)
        
        #.None)
      (:as org/jruby/runtime/builtin/IRubyObject value)))

(exception: (invalid_variant_access {field Text})
  (exception.report
   ["Field" (%.text field)]))

(exception: (invalid_tuple_access {index Nat})
  (exception.report
   ["Index" (%.nat index)]))

(exception: (invalid_index {index java/lang/Object})
  (exception.report
   ["Class" (|> index
                java/lang/Object::getClass
                java/lang/Object::toString)]
   ["Index" (|> index
                java/lang/Object::toString)]))

(import: java/util/Arrays
  ["#::."
   (#static [t] copyOfRange [[t] int int] [t])])

(def: (lux_wrapper_access lux_structure value)
  (-> (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject)
      (-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod))
  (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod []
    [{java/lang/String "[]"}]

    (org/jruby/internal/runtime/methods/DynamicMethod
     [] (call self
              {thread_context org/jruby/runtime/ThreadContext}
              {self org/jruby/runtime/builtin/IRubyObject}
              {module org/jruby/RubyModule}
              {method java/lang/String}
              {args [org/jruby/runtime/builtin/IRubyObject]}
              {block org/jruby/runtime/Block})
     org/jruby/runtime/builtin/IRubyObject
     (let [member (ffi.array_read 0 args)]
       (<| (case (ffi.check org/jruby/RubyFixnum member)
             (#.Some member)
             (case (array.read (org/jruby/RubyFixnum::getLongValue member) value)
               (#.Some value)
               (wrapped_lux_value lux_structure value)

               #.None
               (error! (exception.construct ..invalid_tuple_access [(org/jruby/RubyFixnum::getLongValue member)])))

             #.None)
           (case (ffi.check org/jruby/RubyString member)
             (#.Some member)
             (case (:as Text (org/jruby/RubyString::asJavaString member))
               (^ (static runtime.variant_tag_field))
               (|> value
                   (array.read 0)
                   maybe.assume
                   (:as java/lang/Integer)
                   java/lang/Integer::longValue
                   (org/jruby/RubyFixnum::new ..initial_ruby_runtime))

               (^ (static runtime.variant_flag_field))
               (case (array.read 1 value)
                 #.None
                 ..ruby_nil
                 
                 (#.Some flag)
                 ..lux_unit)
               
               (^ (static runtime.variant_value_field))
               (case (array.read 2 value)
                 (#.Some value)
                 (wrapped_lux_value lux_structure value)

                 #.None
                 (error! (exception.construct ..nil_has_no_lux_representation [])))

               field
               (error! (exception.construct ..invalid_variant_access [field])))
             
             #.None)
           (case (ffi.check org/jruby/RubyRange member)
             (#.Some member)
             (case [(|> member (org/jruby/RubyRange::first thread_context) (ffi.check org/jruby/RubyFixnum))
                    (|> member (org/jruby/RubyRange::size thread_context) (ffi.check org/jruby/RubyFixnum))]
               [(#.Some first) (#.Some size)]
               (let [first (org/jruby/RubyFixnum::getLongValue first)
                     size (org/jruby/RubyFixnum::getLongValue size)]
                 (lux_structure (java/util/Arrays::copyOfRange value first (i.+ first size))))

               _
               (error! (exception.construct ..invalid_index (:as java/lang/Object member))))

             #.None)
           (error! (exception.construct ..invalid_index (:as java/lang/Object member))))))))

(def: (lux_wrapper_equality value)
  (-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod)
  (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod []
    [{java/lang/String "=="}]

    (org/jruby/internal/runtime/methods/DynamicMethod
     [] (call self
              {thread_context org/jruby/runtime/ThreadContext}
              {self org/jruby/runtime/builtin/IRubyObject}
              {module org/jruby/RubyModule}
              {method java/lang/String}
              {args [org/jruby/runtime/builtin/IRubyObject]}
              {block org/jruby/runtime/Block})
     org/jruby/runtime/builtin/IRubyObject
     (let [reference (ffi.array_read 0 args)]
       (case (..read (:as java/lang/Object reference))
         (#try.Success reference)
         (org/jruby/RubyBoolean::newBoolean ..initial_ruby_runtime (is? (: Any reference) (: Any value)))
         
         (#try.Failure error)
         (org/jruby/RubyBoolean::newBoolean ..initial_ruby_runtime false))))))

(def: (lux_wrapper_length value)
  (-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod)
  (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod []
    [{java/lang/String "length"}]

    (org/jruby/internal/runtime/methods/DynamicMethod
     [] (call self
              {thread_context org/jruby/runtime/ThreadContext}
              {self org/jruby/runtime/builtin/IRubyObject}
              {module org/jruby/RubyModule}
              {method java/lang/String}
              {args [org/jruby/runtime/builtin/IRubyObject]}
              {block org/jruby/runtime/Block})
     org/jruby/runtime/builtin/IRubyObject
     (|> value
         array.size
         (org/jruby/RubyFixnum::new ..initial_ruby_runtime)))))

(def: (lux_wrapper_to_s value)
  (-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod)
  (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod []
    [{java/lang/String "to_s"}]

    (org/jruby/internal/runtime/methods/DynamicMethod
     [] (call self
              {thread_context org/jruby/runtime/ThreadContext}
              {self org/jruby/runtime/builtin/IRubyObject}
              {module org/jruby/RubyModule}
              {method java/lang/String}
              {args [org/jruby/runtime/builtin/IRubyObject]}
              {block org/jruby/runtime/Block})
     org/jruby/runtime/builtin/IRubyObject
     (|> value
         debug.inspect
         (org/jruby/RubyString::newInternalFromJavaExternal ..initial_ruby_runtime)))))

(exception: (invalid_operation {method Text})
  (exception.report
   ["Method" (%.text method)]))

(def: (lux_wrapper_respond_to? value)
  (-> (Array java/lang/Object) org/jruby/internal/runtime/methods/DynamicMethod)
  (ffi.object [] org/jruby/internal/runtime/methods/DynamicMethod []
    [{java/lang/String "respond_to?"}]

    (org/jruby/internal/runtime/methods/DynamicMethod
     [] (call self
              {thread_context org/jruby/runtime/ThreadContext}
              {self org/jruby/runtime/builtin/IRubyObject}
              {module org/jruby/RubyModule}
              {method java/lang/String}
              {args [org/jruby/runtime/builtin/IRubyObject]}
              {block org/jruby/runtime/Block})
     org/jruby/runtime/builtin/IRubyObject
     (case (|> args
               (ffi.array_read 0)
               (ffi.check org/jruby/RubySymbol))
       (#.Some method)
       (|> (case (|> method
                     org/jruby/RubySymbol::asJavaString
                     (:as Text))
             (^or "==" "equal?"
                  "to_s" "inspect"
                  "[]" "length" "respond_to?"
                  ## "to_hash"
                  )
             true
             
             _
             false)
           (org/jruby/RubyBoolean::newBoolean ..initial_ruby_runtime))

       #.None
       (error! (exception.construct ..invalid_operation ["respond_to?"]))))))

(exception: (unknown_method {method Text})
  (exception.report
   ["Method" (%.text method)]))

(def: (lux_structure value)
  (-> (Array java/lang/Object) org/jruby/runtime/builtin/IRubyObject)
  (let [meta_class (ffi.object [] org/jruby/RubyClass []
                     [{org/jruby/Ruby
                       ..initial_ruby_runtime}]

                     (org/jruby/RubyClass
                      [] (searchWithCache self
                                          {method java/lang/String})
                      org/jruby/runtime/callsite/CacheEntry
                      (case (:as Text method)
                        "[]"
                        (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_access lux_structure value) 0)

                        (^or "==" "equal?")
                        (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_equality value) 1)

                        "length"
                        (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_length value) 2)

                        (^or "to_s" "inspect")
                        (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_to_s value) 3)

                        "respond_to?"
                        (org/jruby/runtime/callsite/CacheEntry::new (..lux_wrapper_respond_to? value) 4)

                        _
                        (error! (exception.construct ..unknown_method [(:as Text method)])))))]
    (org/jruby/java/proxies/JavaProxy::new ..initial_ruby_runtime meta_class (:as java/lang/Object value))))

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

(def: ensure_macro
  (-> Macro (Maybe org/jruby/RubyProc))
  (|>> (:as java/lang/Object) (ffi.check org/jruby/RubyProc)))

(def: to_host
  (-> Any org/jruby/runtime/builtin/IRubyObject)
  (|>> (:as (Array java/lang/Object))
       ..lux_structure))

(def: (call_macro inputs lux macro)
  (-> (List Code) Lux org/jruby/RubyProc (Try (Try [Lux (List Code)])))
  (:assume
   (do try.monad
     [expansion (org/jruby/RubyProc::call (!ruby_thread_context)
                                          (|> (ffi.array org/jruby/runtime/builtin/IRubyObject 2)
                                              (ffi.array_write 0 (..to_host inputs))
                                              (ffi.array_write 1 (..to_host lux)))
                                          macro)]
     (..read (:as java/lang/Object expansion)))))

(def: (expander macro inputs lux)
  Expander
  (case (ensure_macro macro)
    (#.Some macro)
    (case (call_macro inputs lux macro)
      (#try.Success output)
      (|> output
          (:as java/lang/Object)
          ..read
          (:as (Try (Try [Lux (List Code)]))))

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

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

(def: host
  (IO (Host _.Expression _.Statement))
  (io (let [run! (: (-> (_.Code Any) (Try Any))
                    (function (_ code)
                      (do try.monad
                        [output (org/jruby/embed/ScriptingContainer::runScriptlet (_.code code) ..interpreter)]
                        (..read (maybe.default (:as java/lang/Object [])
                                               output)))))]
        (: (Host _.Expression _.Statement)
           (implementation
            (def: (evaluate! context code)
              (run! code))

            (def: execute! run!)

            (def: (define! context input)
              (let [global (reference.artifact context)
                    @global (_.global global)]
                (do try.monad
                  [#let [definition (_.set (list @global) input)]
                   value (run! definition)]
                  (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! (_.global (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: proc_type
               org/jruby/runtime/Block$Type
               (|> (org/jruby/runtime/Block::NULL_BLOCK)
                   (org/jruby/runtime/Block::type)))

             (def: phase_block_signature
               org/jruby/runtime/Signature
               (org/jruby/runtime/Signature::THREE_ARGUMENTS))

             (def: dummy_static_scope
               org/jruby/parser/StaticScope
               (|> (org/jruby/parser/StaticScopeFactory::new (!ruby_runtime))
                   (org/jruby/parser/StaticScopeFactory::getDummyScope)))

             (def: phase_block_body
               org/jruby/runtime/BlockBody
               (ffi.object [] org/jruby/runtime/BlockBody []
                 [{org/jruby/runtime/Signature ..phase_block_signature}]
                 ## Methods
                 (org/jruby/runtime/BlockBody
                  [] (getFile self)
                  java/lang/String
                  "YOLO")
                 (org/jruby/runtime/BlockBody
                  [] (getLine self)
                  int
                  (ffi.long_to_int (hex "+ABC,123")))
                 (org/jruby/runtime/BlockBody
                  [] (getStaticScope self)
                  org/jruby/parser/StaticScope
                  ..dummy_static_scope)))

             (def: (host_phase partial_application phase)
               (All [s i o]
                 (-> (List Any) (Phase [extension.Bundle s] i o)
                     org/jruby/RubyProc))
               (let [block (ffi.object [] org/jruby/runtime/Block []
                             [{org/jruby/runtime/BlockBody ..phase_block_body}]
                             ## Methods
                             (org/jruby/runtime/Block
                              [] (call self
                                       {_ org/jruby/runtime/ThreadContext}
                                       {inputs [org/jruby/runtime/builtin/IRubyObject]}
                                       {_ org/jruby/runtime/Block})
                              org/jruby/runtime/builtin/IRubyObject
                              (<| try.assume
                                  (let [inputs (array.to_list inputs)])
                                  (case inputs
                                    (^ (list))
                                    (#try.Success (host_phase partial_application phase))
                                    
                                    (^ (list input/0))
                                    (do try.monad
                                      [input/0 (..read (:as java/lang/Object input/0))]
                                      (case partial_application
                                        (^ (list))
                                        (wrap (host_phase (list input/0) phase))
                                        
                                        (^ (list partial/0))
                                        (wrap (host_phase (list partial/0 input/0) phase))
                                        
                                        (^ (list partial/0 partial/1))
                                        (wrap (..to_host ((:as (-> Any Any Any Any) phase)
                                                          partial/0
                                                          partial/1
                                                          input/0)))

                                        _
                                        (exception.throw ..invaid_phase_application [partial_application (list.size inputs)])))
                                    
                                    (^ (list input/0 input/1))
                                    (do try.monad
                                      [input/0 (..read (:as java/lang/Object input/0))
                                       input/1 (..read (:as java/lang/Object input/1))]
                                      (case partial_application
                                        (^ (list))
                                        (wrap (host_phase (list input/0 input/1) phase))
                                        
                                        (^ (list partial/0))
                                        (wrap (..to_host ((:as (-> Any Any Any Any) phase)
                                                          partial/0
                                                          input/0
                                                          input/1)))
                                        
                                        _
                                        (exception.throw ..invaid_phase_application [partial_application (list.size inputs)])))
                                    
                                    (^ (list input/0 input/1 input/2))
                                    (do try.monad
                                      [input/0 (..read (:as java/lang/Object input/0))
                                       input/1 (..read (:as java/lang/Object input/1))
                                       input/2 (..read (:as java/lang/Object 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 (list.size inputs)])))
                                    
                                    _
                                    (exception.throw ..invaid_phase_application [partial_application (list.size inputs)])))))]
                 (org/jruby/RubyProc::newProc (!ruby_runtime) block ..proc_type)))

             (def: (extender phase_wrapper)
               (-> 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_macro handler))
                      output (org/jruby/RubyProc::call (!ruby_thread_context)
                                                       (|> (ffi.array org/jruby/runtime/builtin/IRubyObject 5)
                                                           (ffi.array_write 0 (org/jruby/RubyString::newInternalFromJavaExternal (!ruby_runtime) name))
                                                           (ffi.array_write 1 (:as org/jruby/runtime/builtin/IRubyObject (phase_wrapper phase)))
                                                           (ffi.array_write 2 (..to_host archive))
                                                           (ffi.array_write 3 (..to_host parameters))
                                                           (ffi.array_write 4 (..to_host state)))
                                                       handler)]
                     (..read (:as java/lang/Object output))))))

      @.ruby
      (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))
                     @.ruby (|>>)})))))

(def: platform
  (IO (Platform Register _.Expression _.Statement))
  (do io.monad
    [host ..host]
    (wrap {#platform.&file_system (file.async file.default)
           #platform.host host
           #platform.phase ruby.generate
           #platform.runtime runtime.generate
           #platform.phase_wrapper ..phase_wrapper
           #platform.write (|>> _.code (\ utf8.codec encode))})))

(def: (program context program)
  (Program _.Expression _.Statement)
  (_.statement (_.apply_lambda/* (list (runtime.lux//program_args _.command_line_arguments)
                                       _.nil)
                                 program)))

(def: (declare_success! _)
  (-> Any (Promise Any))
  (promise.future (\ world/program.default exit +0)))

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