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

... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.

(.require
 [library
  [lux (.except)
   [program (.only program)]
   ["[0]" ffi]
   ["[0]" debug]
   [abstract
    ["[0]" monad (.only do)]]
   [control
    ["[0]" pipe]
    ["[0]" maybe]
    ["[0]" try (.only Try)]
    ["[0]" exception (.only Exception)]
    ["[0]" io (.only IO io)]
    [concurrency
     ["[0]" promise (.only Promise)]]]
   [data
    ["[0]" text (.use "[1]#[0]" hash)
     ["%" \\format (.only format)]
     [encoding
      ["[0]" utf8]]]
    [collection
     ["[0]" array (.only Array)]]]
   [macro
    ["[0]" template]]
   [math
    [number (.only hex)
     ["n" nat]
     ["[0]" i64]]]
   ["[0]" world
    ["[0]" file]
    ["[1]/[0]" program]]
   ["@" target
    ["_" php]]
   [meta
    [compiler
     [phase (.only Operation Phase)]
     [reference
      [variable (.only Register)]]
     [language
      [lux
       [program (.only Program)]
       [translation (.only Context Host)]
       ["[0]" synthesis]
       [analysis
        [macro (.only Expander)]]
       [phase
        ["[0]" extension (.only Extender Handler)
         ["[1]/[0]" bundle]
         ["[0]" analysis
          ["[1]" php]]
         ["[0]" translation
          ["[1]" php]]]
        [translation
         ["[0]" reference]
         ["[0]" php
          ["[0]" runtime]]]]]]
     [default
      ["[0]" platform (.only 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))

(with_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.def (unknown_kind_of_object object)
  (Exception java/lang/Object)
  (exception.report
   (list ["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))
      (when (ffi.as java/lang/Boolean value)
        {.#Some value}
        (if (as Bit value)
          (php/runtime/memory/TrueMemory::INSTANCE)
          (php/runtime/memory/FalseMemory::INSTANCE))

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

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

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

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

        {.#None})
      (when (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
         (`` (<| (,, (with_template [<class> <method> <extractor>]
                       [(when (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
         (when (as Text index)
           runtime.variant_tag_field
           (|> value
               (array.read! 0)
               maybe.trusted
               (as java/lang/Integer)
               php/runtime/memory/LongMemory::valueOf)

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

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

           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)]
          (when (ffi.as php/runtime/memory/NullMemory value)
            {.#Some _}
            (again (++ idx) output)

            {.#None}
            (when (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))
  (when [(|> 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
                       (when (|> 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.def .public nulll_has_no_lux_representation)

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

(def (read host_object)
  Reader
  (`` (<| (,, (with_template [<class> <constant>]
                [(when (ffi.as <class> host_object)
                   {.#Some _}
                   {try.#Success <constant>}

                   {.#None})]

                [php/runtime/memory/FalseMemory false]
                [php/runtime/memory/TrueMemory true]
                ))
          (,, (with_template [<class> <post>]
                [(when (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}]]
                ))
          (when (ffi.as php/runtime/memory/ArrayMemory host_object)
            {.#Some value}
            (if (|> value
                    (php/runtime/memory/ArrayMemory::get ..tuple_size_field)
                    (pipe.when {.#Some _} false {.#None} true))
              (read_variant read value)
              (read_tuple read value))

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

(exception.def (cannot_apply_a_non_function object)
  (Exception java/lang/Object)
  (exception.report
   (list ["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
  (when (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 (of 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.translate
           platform.#runtime runtime.translate
           platform.#write (|>> _.code (of 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 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 (of world/program.default exit +0)))

(`` (def _
      (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)
                                   translation.bundle
                                   extension/bundle.empty
                                   ..program
                                   [(& Nat _.Label) _.Expression _.Statement]
                                   ..extender
                                   service
                                   [(packager.package (_.manual "<?php")
                                                      _.code
                                                      _.then
                                                      (|>>))
                                    (format "program"
                                            extension)])]
                    (..declare_success! []))
              (io.io [])))))))