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

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

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

(ffi.import: java/lang/reflect/Field
  "[1]::[0]"
  (get [java/lang/Object] java/lang/Object))

(ffi.import: java/lang/reflect/AccessibleObject
  "[1]::[0]"
  (setAccessible [boolean] void))

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

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

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

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

(ffi.import: php/runtime/Memory
  "[1]::[0]"
  (valueOfIndex "as" generic_valueOfIndex [php/runtime/env/TraceInfo php/runtime/Memory] php/runtime/Memory)
  (valueOfIndex "as" long_valueOfIndex [php/runtime/env/TraceInfo long] php/runtime/Memory)
  (valueOfIndex "as" string_valueOfIndex [php/runtime/env/TraceInfo java/lang/String] php/runtime/Memory))

(ffi.import: php/runtime/Memory$Type
  "[1]::[0]"
  ("enum" ARRAY))

(ffi.import: php/runtime/memory/NullMemory
  "[1]::[0]"
  ("static" INSTANCE php/runtime/memory/NullMemory))

(ffi.import: php/runtime/memory/FalseMemory
  "[1]::[0]"
  ("static" INSTANCE php/runtime/memory/FalseMemory))

(ffi.import: php/runtime/memory/TrueMemory
  "[1]::[0]"
  ("static" INSTANCE php/runtime/memory/TrueMemory))

(ffi.import: php/runtime/memory/LongMemory
  "[1]::[0]"
  (new [long])
  (toLong [] long)
  ("static" valueOf "manual" [int] php/runtime/Memory))

(ffi.import: php/runtime/memory/DoubleMemory
  "[1]::[0]"
  (new [double])
  (toDouble [] double))

(ffi.import: php/runtime/memory/StringMemory
  "[1]::[0]"
  (new [java/lang/String])
  (toString [] java/lang/String))

(ffi.import: php/runtime/memory/ReferenceMemory
  "[1]::[0]"
  (getValue [] php/runtime/Memory))

(ffi.import: php/runtime/memory/ArrayMemory
  "[1]::[0]"
  (new [[java/lang/Object]])
  (size [] int)
  (isMap [] boolean)
  (get [php/runtime/Memory] "?" php/runtime/Memory))

(ffi.import: php/runtime/lang/IObject
  "[1]::[0]")

(ffi.import: php/runtime/memory/ObjectMemory
  "[1]::[0]"
  (value php/runtime/lang/IObject))

(ffi.import: php/runtime/env/Environment
  "[1]::[0]")

(ffi.import: php/runtime/env/TraceInfo
  "[1]::[0]"
  (new [java/lang/String int int]))

(ffi.import: php/runtime/reflection/FunctionEntity
  "[1]::[0]")

(ffi.import: php/runtime/invoke/InvokeHelper
  "[1]::[0]"
  ("static" callAny [php/runtime/Memory [php/runtime/Memory] php/runtime/env/Environment php/runtime/env/TraceInfo]
   "try" php/runtime/Memory))

(ffi.import: php/runtime/lang/Closure
  "[1]::[0]"
  (call [php/runtime/env/Environment [php/runtime/Memory]] "try" php/runtime/Memory))

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

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

  [StructureValue]
  )

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

(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: (value_wrapper lux_structure value)
  (-> (-> (Array java/lang/Object) php/runtime/Memory) java/lang/Object php/runtime/Memory)
  (<| (if (ffi.null? value)
        (php/runtime/memory/NullMemory::INSTANCE))
      (case (ffi.as java/lang/Boolean value)
        {.#Some value}
        (if (as Bit value)
          (php/runtime/memory/TrueMemory::INSTANCE)
          (php/runtime/memory/FalseMemory::INSTANCE))

        {.#None})
      (case (ffi.as java/lang/Long value)
        {.#Some value}
        (php/runtime/memory/LongMemory::new value)

        {.#None})
      (case (ffi.as java/lang/Double value)
        {.#Some value}
        (php/runtime/memory/DoubleMemory::new value)

        {.#None})
      (case (ffi.as java/lang/String value)
        {.#Some value}
        (php/runtime/memory/StringMemory::new value)

        {.#None})
      (case (ffi.as [java/lang/Object] value)
        {.#Some value}
        (lux_structure (as (Array java/lang/Object) value))

        {.#None})
      (case (ffi.as php/runtime/memory/ObjectMemory value)
        {.#Some value}
        value

        {.#None})
      (undefined)
      ))

(def: unit
  (php/runtime/memory/StringMemory::new ""))

(def: (lux_structure value)
  (-> (Array java/lang/Object) php/runtime/Memory)
  (`` (ffi.object [] php/runtime/Memory
        [program/StructureValue]
        [php/runtime/Memory$Type php/runtime/Memory$Type::ARRAY]
        ... Methods
        (program/StructureValue
         [] (getValue self []) java/lang/Object
         (as_expected value))

        (php/runtime/Memory
         [] (toString self [])
         java/lang/String
         (debug.inspect value))

        (php/runtime/Memory
         [] (valueOfIndex self [trace php/runtime/env/TraceInfo
                                index php/runtime/Memory])
         php/runtime/Memory
         (`` (<| (~~ (template [<class> <method> <extractor>]
                       [(case (ffi.as <class> index)
                          {.#Some index}
                          (<method> trace (<extractor> index) self)
                          
                          {.#None})]

                       [php/runtime/memory/ReferenceMemory
                        php/runtime/Memory::generic_valueOfIndex
                        php/runtime/memory/ReferenceMemory::getValue]
                       [php/runtime/memory/LongMemory
                        php/runtime/Memory::long_valueOfIndex
                        php/runtime/memory/LongMemory::toLong]
                       [php/runtime/memory/StringMemory
                        php/runtime/Memory::string_valueOfIndex
                        php/runtime/memory/StringMemory::toString]
                       ))
                 (undefined))))

        (php/runtime/Memory
         [] (valueOfIndex self [trace php/runtime/env/TraceInfo
                                index long])
         php/runtime/Memory
         (|> value
             (array.read! index)
             maybe.trusted
             (..value_wrapper lux_structure)))

        (php/runtime/Memory
         [] (valueOfIndex self [trace php/runtime/env/TraceInfo
                                index java/lang/String])
         php/runtime/Memory
         (case (as Text index)
           (pattern (static runtime.variant_tag_field))
           (|> value
               (array.read! 0)
               maybe.trusted
               (as java/lang/Integer)
               php/runtime/memory/LongMemory::valueOf)

           (pattern (static runtime.variant_flag_field))
           (case (array.read! 1 value)
             {.#None}
             (php/runtime/memory/NullMemory::INSTANCE)
             
             {.#Some value}
             ..unit)

           (pattern (static runtime.variant_value_field))
           (|> value
               (array.read! 2)
               maybe.trusted
               (..value_wrapper lux_structure))

           (pattern (static runtime.tuple_size_field))
           (php/runtime/memory/LongMemory::new (array.size value))

           _
           (undefined)))
        )))

(def: (read_tuple read host_object)
  (-> Reader php/runtime/memory/ArrayMemory (Try Any))
  (let [size (|> host_object
                 php/runtime/memory/ArrayMemory::size
                 (as Nat)
                 --)]
    (loop (again [idx 0
                  output (as (Array Any) (array.new size))])
      (if (n.< size idx)
        (let [value (|> host_object
                        (php/runtime/memory/ArrayMemory::get (php/runtime/memory/LongMemory::new (.int idx)))
                        maybe.trusted
                        (as php/runtime/memory/ReferenceMemory)
                        php/runtime/memory/ReferenceMemory::getValue)]
          (case (ffi.as php/runtime/memory/NullMemory value)
            {.#Some _}
            (again (++ idx) output)

            {.#None}
            (case (read value)
              {try.#Success lux_value}
              (again (++ idx) (array.write! idx lux_value output))

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

(def: variant_tag_field
  (php/runtime/memory/StringMemory::new runtime.variant_tag_field))

(def: variant_value_field
  (php/runtime/memory/StringMemory::new runtime.variant_value_field))

(def: variant_flag_field
  (php/runtime/memory/StringMemory::new runtime.variant_flag_field))

(def: (read_variant read host_object)
  (-> Reader php/runtime/memory/ArrayMemory (Try Any))
  (case [(|> host_object
             (php/runtime/memory/ArrayMemory::get ..variant_tag_field)
             maybe.trusted
             read)
         (|> host_object
             (php/runtime/memory/ArrayMemory::get ..variant_value_field)
             maybe.trusted
             read)]
    [{try.#Success tag} {try.#Success value}]
    {try.#Success [(java/lang/Long::intValue (as java/lang/Long tag))
                   (is Any
                       (case (|> host_object
                                 (php/runtime/memory/ArrayMemory::get ..variant_flag_field)
                                 maybe.trusted
                                 (as php/runtime/memory/ReferenceMemory)
                                 php/runtime/memory/ReferenceMemory::getValue
                                 (ffi.as php/runtime/memory/NullMemory))
                         {.#Some _}
                         (ffi.null)

                         {.#None}
                         synthesis.unit))
                   value]}

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

(exception: .public nulll_has_no_lux_representation)

(def: tuple_size_field
  (php/runtime/memory/StringMemory::new runtime.tuple_size_field))

(def: (read host_object)
  Reader
  (`` (<| (~~ (template [<class> <constant>]
                [(case (ffi.as <class> host_object)
                   {.#Some _}
                   {try.#Success <constant>}

                   {.#None})]

                [php/runtime/memory/FalseMemory false]
                [php/runtime/memory/TrueMemory true]
                ))
          (~~ (template [<class> <post>]
                [(case (ffi.as <class> host_object)
                   {.#Some value}
                   (`` (|> value (~~ (template.splice <post>))))

                   {.#None})]

                [program/StructureValue [program/StructureValue::getValue {try.#Success}]]
                [php/runtime/memory/LongMemory [php/runtime/memory/LongMemory::toLong {try.#Success}]]
                [php/runtime/memory/DoubleMemory [php/runtime/memory/DoubleMemory::toDouble {try.#Success}]]
                [php/runtime/memory/StringMemory [php/runtime/memory/StringMemory::toString {try.#Success}]]
                [php/runtime/memory/ReferenceMemory [php/runtime/memory/ReferenceMemory::getValue read]]
                [php/runtime/memory/ObjectMemory [{try.#Success}]]
                ))
          (case (ffi.as php/runtime/memory/ArrayMemory host_object)
            {.#Some value}
            (if (|> value
                    (php/runtime/memory/ArrayMemory::get ..tuple_size_field)
                    (pipe.case {.#Some _} false {.#None} true))
              (read_variant read value)
              (read_tuple read value))

            {.#None})
          (exception.throw ..unknown_kind_of_object host_object)
          )))

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

(ffi.import: javax/script/ScriptEngine
  "[1]::[0]"
  (eval [java/lang/String] "try" Object))

(ffi.import: org/develnext/jphp/scripting/JPHPScriptEngine
  "[1]::[0]"
  (new []))

(def: (ensure_macro macro)
  (-> Macro (Maybe php/runtime/memory/ObjectMemory))
  (|> macro
      (as java/lang/Object)
      (ffi.as php/runtime/memory/ObjectMemory)))

(def: interpreter
  (org/develnext/jphp/scripting/JPHPScriptEngine::new))

(def: default_environment
  php/runtime/env/Environment
  (|> ..interpreter
      java/lang/Object::getClass
      (java/lang/Class::getDeclaredField "environment")
      (pipe.exec [(java/lang/reflect/AccessibleObject::setAccessible true)])
      (java/lang/reflect/Field::get ..interpreter)
      (as php/runtime/env/Environment)))

(def: (call_macro inputs lux macro)
  (-> (List Code) Lux php/runtime/memory/ObjectMemory (Try (Try [Lux (List Code)])))
  (<| as_expected
      (do try.monad
        [output (php/runtime/lang/Closure::call ..default_environment
                                                (|> (ffi.array php/runtime/Memory 3)
                                                    (ffi.write! 0 macro)
                                                    (ffi.write! 1 (lux_structure (as (Array java/lang/Object) inputs)))
                                                    (ffi.write! 2 (lux_structure (as (Array java/lang/Object) lux))))
                                                (as php/runtime/lang/Closure
                                                    (php/runtime/memory/ObjectMemory::value macro)))]
        (..read (as java/lang/Object output)))))

(def: (expander macro inputs lux)
  Expander
  (case (ensure_macro macro)
    {.#Some macro}
    (call_macro inputs lux macro)

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

(def: host
  (IO (Host _.Expression _.Statement))
  (io (let [run! (is (-> (_.Code Any) (Try Any))
                     (function (_ code)
                       (do try.monad
                         [output (javax/script/ScriptEngine::eval (format "<?php " (_.code code)) ..interpreter)]
                         (..read output))))]
        (is (Host _.Expression _.Statement)
            (structure
             (def: (evaluate! context code)
               (run! (_.return code)))
             
             (def: execute! run!)
             
             (def: (define! context input)
               (let [global (reference.artifact context)
                     @global (_.global global)]
                 (do try.monad
                   [#let [definition (_.set! @global input)]
                    _ (run! definition)
                    value (run! (_.return @global))]
                   (wrap [global value definition]))))

             (def: (ingest context content)
               (|> content (# utf8.codec decoded) try.trusted (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)))))))))))

(def: platform
  (IO (Platform [Nat _.Label] _.Expression _.Statement))
  (do io.monad
    [host ..host]
    (wrap [platform.#&file_system (file.async file.default)
           platform.#host host
           platform.#phase php.generate
           platform.#runtime runtime.generate
           platform.#write (|>> _.code (# utf8.codec encoded))])))

(def: (program context program)
  (Program _.Expression _.Statement)
  (_.; (_.apply/2 program
                  [(runtime.lux//program_args _.command_line_arguments)
                   _.null])))

(for @.old
     (def: extender
       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.from_maybe (..ensure_macro handler))
              #let [to_php (is (-> Any php/runtime/Memory)
                               (|>> (as (Array java/lang/Object)) lux_structure (as php/runtime/Memory)))]
              output (php/runtime/lang/Closure::call ..default_environment
                                                     (|> (ffi.array php/runtime/Memory 6)
                                                         (ffi.write! 0 handler)
                                                         (ffi.write! 1 (php/runtime/memory/StringMemory::new name))
                                                         (ffi.write! 2 (to_php phase))
                                                         (ffi.write! 3 (to_php archive))
                                                         (ffi.write! 4 (to_php parameters))
                                                         (ffi.write! 5 (to_php state)))
                                                     (as php/runtime/lang/Closure
                                                         (php/runtime/memory/ObjectMemory::value handler)))]
             (..read output))))

     @.php
     (def: (extender handler)
       Extender
       (as_expected handler)))

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

(`` (program: [service /cli.service]
      (let [extension ".php"]
        (do io.monad
          [platform ..platform]
          (exec (do promise.monad
                  [_ (/.compiler [/static.#host @.php
                                  /static.#host_module_extension extension
                                  /static.#target (/cli.target service)
                                  /static.#artifact_extension extension]
                                 ..expander
                                 analysis.bundle
                                 (io.io platform)
                                 generation.bundle
                                 extension/bundle.empty
                                 ..program
                                 [(& Nat _.Label) _.Expression _.Statement]
                                 ..extender
                                 service
                                 [(packager.package (_.manual "<?php")
                                                    _.code
                                                    _.then
                                                    (|>>))
                                  (format (/cli.target service)
                                          (# file.default separator)
                                          "program"
                                          extension)])]
                  (..declare_success! []))
            (io.io []))))))