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

(.module:
  [lux #*
   [program (#+ program:)]
   ["." host]
   ["." debug]
   [abstract
    ["." monad (#+ do)]]
   [control
    ["." try (#+ Try)]
    ["." exception (#+ exception:)]
    ["." io (#+ IO io)]
    [concurrency
     ["." promise (#+ Promise)]]]
   [data
    ["." maybe]
    ["." text ("#\." hash)
     ["%" format (#+ format)]
     ["." encoding]]
    [collection
     ["." array (#+ Array)]]]
   [macro
    ["." template]]
   [math
    [number (#+ hex)
     ["n" nat]
     ["." i64]]]
   ["." world #_
    ["." file]
    ["#/." program]]
   ["@" target
    ["_" php]]
   [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 #_
          ["#" php]]
         ["." generation #_
          ["#" php]]]
        [generation
         ["." reference]
         ["." php
          ["." runtime]]]]]]
     [default
      ["." platform (#+ Platform)]]
     [meta
      ["." packager #_
       ["#" script]]]]]]
  [program
   ["/" compositor
    ["#." cli]
    ["#." static]]])

(host.import: java/lang/String)

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

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

(host.import: java/lang/Integer)

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

(host.import: php/runtime/Memory)

(host.import: php/runtime/Memory$Type
  ["#::."
   (#enum ARRAY)])

(host.import: php/runtime/memory/NullMemory)

(host.import: php/runtime/memory/FalseMemory)
(host.import: php/runtime/memory/TrueMemory)

(host.import: php/runtime/memory/LongMemory
  ["#::."
   (new [long])
   (toLong [] long)])

(host.import: php/runtime/memory/DoubleMemory
  ["#::."
   (toDouble [] double)])

(host.import: php/runtime/memory/StringMemory
  ["#::."
   (new [java/lang/String])
   (toString [] java/lang/String)])

(host.import: php/runtime/memory/ReferenceMemory
  ["#::."
   (getValue [] php/runtime/Memory)])

(host.import: php/runtime/memory/ArrayMemory
  ["#::."
   (new [[java/lang/Object]])
   (size [] int)
   (isMap [] boolean)
   (get [php/runtime/Memory] php/runtime/Memory)])

(host.import: php/runtime/lang/IObject)

(host.import: php/runtime/memory/ObjectMemory
  ["#::."
   (value php/runtime/lang/IObject)])

(host.import: php/runtime/env/Environment
  ["#::."
   (#static current [] php/runtime/env/Environment)])

(host.import: php/runtime/env/TraceInfo
  ["#::."
   (new [java/lang/String int int])])

(host.import: php/runtime/reflection/FunctionEntity)

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

(host.import: php/runtime/lang/Closure
  ["#::."
   (call [php/runtime/env/Environment [php/runtime/Memory]] #try php/runtime/Memory)])

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

   (`` (host.import: (~~ (template.identifier ["program/" <name>]))
         ["#::."
          (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: (lux_structure value)
  (-> (Array java/lang/Object)
      php/runtime/memory/ArrayMemory
      ## php/runtime/Memory
      )
  (`` (host.object [] ## php/runtime/Memory
        php/runtime/memory/ArrayMemory
        [program/StructureValue]
        [## {php/runtime/Memory$Type php/runtime/Memory$Type::ARRAY}
         ]
        ## Methods
        (program/StructureValue
         [] (getValue self) java/lang/Object
         (:assume value))

        (php/runtime/memory/ArrayMemory
         [] (size self)
         int
         (exec
           (debug.log! "{lux_structure#size}")
           (:assume (array.size value))))
        
        (php/runtime/memory/ArrayMemory
         [] (get self {key php/runtime/Memory})
         php/runtime/Memory
         (exec
           (debug.log! (format "{lux_structure#get}" text.new_line
                               (exception.construct unknown_kind_of_object key)))
           (error! "OOPS!")))

        (php/runtime/memory/ArrayMemory
         [] (getOrCreate self {key php/runtime/Memory})
         php/runtime/memory/ReferenceMemory
         (exec
           (debug.log! (format "{lux_structure#getOrCreate}" text.new_line
                               (exception.construct unknown_kind_of_object key)))
           (error! "OOPS!")))

        (php/runtime/memory/ArrayMemory
         [] (getOrCreateAsShortcut self {key php/runtime/Memory})
         php/runtime/memory/ReferenceMemory
         (exec
           (debug.log! (format "{lux_structure#getOrCreateAsShortcut}" text.new_line
                               (exception.construct unknown_kind_of_object key)))
           (error! "OOPS!")))

        (php/runtime/memory/ArrayMemory
         [] (getByScalarOrCreateAsShortcut self {key java/lang/Object})
         php/runtime/memory/ReferenceMemory
         (exec
           (debug.log! (format "{lux_structure#getByScalarOrCreateAsShortcut}" text.new_line
                               (exception.construct unknown_kind_of_object key)))
           (error! "OOPS!")))

        (php/runtime/memory/ArrayMemory
         [] (getByScalarOrCreate self {key java/lang/Object})
         php/runtime/memory/ReferenceMemory
         (exec
           (debug.log! (format "{lux_structure#getByScalarOrCreate}" text.new_line
                               (exception.construct unknown_kind_of_object key)))
           (error! "OOPS!")))

        (php/runtime/memory/ArrayMemory
         [] (getByScalar self {key java/lang/Object})
         php/runtime/memory/ReferenceMemory
         (exec
           (debug.log! (format "{lux_structure#getByScalar}" text.new_line
                               (exception.construct unknown_kind_of_object key)))
           (error! "OOPS!")))

        ## (php/runtime/Memory
        ##  [] (refOfIndex self
        ##                 {trace php/runtime/env/TraceInfo}
        ##                 {index php/runtime/Memory})
        ##  php/runtime/Memory
        ##  (exec
        ##    (log! (format "{lux_structure#refOfIndex}" text.new_line
        ##                  (exception.construct unknown_kind_of_object index)))
        ##    (error! "OOPS!")))

        ## (php/runtime/Memory
        ##  [] (refOfIndexAsShortcut self
        ##                           {trace php/runtime/env/TraceInfo}
        ##                           {index php/runtime/Memory})
        ##  php/runtime/Memory
        ##  (exec
        ##    (log! (format "{lux_structure#refOfIndexAsShortcut}" text.new_line
        ##                  (exception.construct unknown_kind_of_object index)))
        ##    (error! "OOPS!")))

        ## (php/runtime/Memory
        ##  [] (refOfIndex self
        ##                 {trace php/runtime/env/TraceInfo}
        ##                 {index long})
        ##  php/runtime/Memory
        ##  (exec
        ##    (log! (format "{lux_structure#refOfIndex long}" text.new_line
        ##                  (exception.construct unknown_kind_of_object index)))
        ##    (error! "OOPS!")))

        ## (php/runtime/Memory
        ##  [] (refOfIndex self
        ##                 {trace php/runtime/env/TraceInfo}
        ##                 {index java/lang/String})
        ##  php/runtime/Memory
        ##  (exec
        ##    (log! (format "{lux_structure#refOfIndex java/lang/String}" text.new_line
        ##                  (exception.construct unknown_kind_of_object index)))
        ##    (error! "OOPS!")))

        ## (~~ (template [<name>]
        ##       [(php/runtime/Memory [] (<name> self) php/runtime/Memory (undefined))]

        ##       [inc] [dec] [negative] [toNumeric]
        ##       ))

        ## (~~ (template [<name>]
        ##       [(php/runtime/Memory [] (<name> self {other php/runtime/Memory}) php/runtime/Memory (undefined))]

        ##       [plus] [minus] [mul] [pow] [div]
        ##       [identical] [equal] [notEqual]
        ##       [smaller] [smallerEq] [greater] [greaterEq]
        ##       ))

        ## (php/runtime/Memory [] (toLong self) long (undefined))
        ## (php/runtime/Memory [] (toDouble self) double (undefined))
        ## (php/runtime/Memory [] (toBoolean self) boolean (undefined))
        ## (php/runtime/Memory [] (toString self) java/lang/String (undefined))
        ## (php/runtime/Memory [] (getBinaryBytes self {input java/nio/charset/Charset}) ByteArray (undefined))
        )))

(def: (read_tuple read host_object)
  (-> Reader php/runtime/memory/ArrayMemory (Try Any))
  (let [size (:coerce Nat (php/runtime/memory/ArrayMemory::size host_object))]
    (loop [idx 0
           output (:coerce (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)))
                        (:coerce php/runtime/memory/ReferenceMemory)
                        php/runtime/memory/ReferenceMemory::getValue)]
          (case (host.check php/runtime/memory/NullMemory value)
            (#.Some _)
            (recur (inc idx) output)

            #.None
            (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)))))

(def: (read_variant read host_object)
  (-> Reader php/runtime/memory/ArrayMemory (Try Any))
  (case [(|> host_object
             (php/runtime/memory/ArrayMemory::get (php/runtime/memory/StringMemory::new runtime.variant_tag_field))
             read)
         (|> host_object
             (php/runtime/memory/ArrayMemory::get (php/runtime/memory/StringMemory::new runtime.variant_value_field))
             read)]
    [(#try.Success tag) (#try.Success value)]
    (#try.Success [(java/lang/Long::intValue (:coerce java/lang/Long tag))
                   (: Any
                      (case (|> host_object
                                (php/runtime/memory/ArrayMemory::get (php/runtime/memory/StringMemory::new runtime.variant_flag_field))
                                (:coerce php/runtime/memory/ReferenceMemory)
                                php/runtime/memory/ReferenceMemory::getValue
                                (host.check php/runtime/memory/NullMemory))
                        (#.Some _)
                        (host.null)

                        #.None
                        synthesis.unit))
                   value])

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

(exception: #export nulll_has_no_lux_representation)

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

                   #.None)]

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

                   #.None)]

                [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 (host.check php/runtime/memory/ArrayMemory host_object)
            (#.Some value)
            (if (php/runtime/memory/ArrayMemory::isMap value)
              (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)]))

(host.import: javax/script/ScriptEngine
  ["#::."
   (eval [java/lang/String] #try Object)])

(host.import: org/develnext/jphp/scripting/JPHPScriptEngine
  ["#::."
   (new [])])

(def: (ensure_macro macro)
  ## (-> Macro (Maybe php/runtime/lang/Closure))
  ## (do maybe.monad
  ##   [object_memory (|> macro
  ##                      (:coerce java/lang/Object)
  ##                      (host.check php/runtime/memory/ObjectMemory))]
  ##   (|> object_memory
  ##       php/runtime/memory/ObjectMemory::value
  ##       (host.check php/runtime/lang/Closure)))
  (-> Macro (Maybe php/runtime/memory/ObjectMemory))
  (|> macro
      (:coerce java/lang/Object)
      (host.check php/runtime/memory/ObjectMemory)))

(def: (call_macro inputs lux macro)
  (-> (List Code) Lux
      php/runtime/memory/ObjectMemory
      ## php/runtime/lang/Closure
      (Try (Try [Lux (List Code)])))
  (<| :assume
      (do try.monad
        [#let [_ (debug.log! (format "{call_macro 0} " (exception.construct ..unknown_kind_of_object (:coerce java/lang/Object (php/runtime/memory/ObjectMemory::value macro)))))]
         output (php/runtime/lang/Closure::call (php/runtime/env/Environment::current)
                                                (|> (host.array php/runtime/Memory 3)
                                                    (host.array_write 0 macro)
                                                    (host.array_write 1
                                                                      ## (php/runtime/memory/ArrayMemory::new (:coerce (Array java/lang/Object) inputs))
                                                                      (lux_structure (:coerce (Array java/lang/Object) inputs))
                                                                      )
                                                    (host.array_write 2
                                                                      ## (php/runtime/memory/ArrayMemory::new (:coerce (Array java/lang/Object) lux))
                                                                      (lux_structure (:coerce (Array java/lang/Object) lux))
                                                                      ))
                                                (:coerce php/runtime/lang/Closure
                                                         (php/runtime/memory/ObjectMemory::value macro)))
         ## output (php/runtime/invoke/InvokeHelper::callAny macro
         ##                                                  (|> (host.array php/runtime/Memory 2)
         ##                                                      ## (host.array_write 0 macro)
         ##                                                      ## (host.array_write 1 macro)
         ##                                                      (host.array_write 0 ## (php/runtime/memory/ArrayMemory::new (:coerce (Array java/lang/Object) inputs))
         ##                                                                        (lux_structure (:coerce (Array java/lang/Object) inputs))
         ##                                                                        )
         ##                                                      (host.array_write 1 ## (php/runtime/memory/ArrayMemory::new (:coerce (Array java/lang/Object) lux))
         ##                                                                        (lux_structure (:coerce (Array java/lang/Object) lux))
         ##                                                                        ))
         ##                                                  (php/runtime/env/Environment::current)
         ##                                                  (php/runtime/env/TraceInfo::new "" +0 +0))
         #let [_ (debug.log! (format "{call_macro 1} " (debug.inspect output)))
               _ (debug.log! (format "{call_macro 2} " (exception.construct ..unknown_kind_of_object (:coerce java/lang/Object output))))]]
        (..read (:coerce 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 (:coerce java/lang/Object macro))))

(def: separator "___")

(def: host
  (IO (Host _.Expression _.Statement))
  (io (let [interpreter (org/develnext/jphp/scripting/JPHPScriptEngine::new)
            run! (: (-> (_.Code Any) (Try Any))
                    (function (_ code)
                      (do try.monad
                        [output (javax/script/ScriptEngine::eval (format "<?php " (_.code code)) interpreter)]
                        (..read output))))]
        (: (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 (\ encoding.utf8 decode) try.assume (:coerce _.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 _.Var _.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 (\ encoding.utf8 encode))})))

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

(for {@.old
      (def: extender
        Extender
        ## TODO: Stop relying on coercions ASAP.
        (<| (:coerce Extender)
            (function (@self handler))
            (:coerce Handler)
            (function (@self name phase))
            (:coerce Phase)
            (function (@self archive parameters))
            (:coerce Operation)
            (function (@self state))
            (:coerce Try)
            try.assume
            (:coerce Try)
            (do try.monad
              [handler (try.from_maybe (..ensure_macro handler))
               #let [to_php (: (-> Any php/runtime/Memory)
                               (|>> (:coerce (Array java/lang/Object)) lux_structure (:coerce php/runtime/Memory)))]
               output (php/runtime/lang/Closure::call (php/runtime/env/Environment::current)
                                                      (|> (host.array php/runtime/Memory 6)
                                                          (host.array_write 0 handler)
                                                          (host.array_write 1 (php/runtime/memory/StringMemory::new name))
                                                          (host.array_write 2 (to_php phase))
                                                          (host.array_write 3 (to_php archive))
                                                          (host.array_write 4 (to_php parameters))
                                                          (host.array_write 5 (to_php state)))
                                                      (:coerce php/runtime/lang/Closure
                                                               (php/runtime/memory/ObjectMemory::value handler)))]
              (..read output))))

      @.php
      (def: (extender handler)
        Extender
        (:assume handler))})

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

(def: (scope body)
  (-> _.Statement _.Statement)
  (let [@program (_.constant "lux_program")]
    ($_ _.then
        (_.define_function @program (list) body)
        (_.; (_.apply/* (list) @program))
        )))

## (program: [{service /cli.service}]
##   (/.compiler ..expander
##               ..platform
##               extension.bundle
##               ..program
##               service))

(`` (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
                                 [_.Var _.Expression _.Statement]
                                 ..extender
                                 service
                                 [(packager.package (_.manual "")
                                                    _.code
                                                    _.then
                                                    ..scope)
                                  (format (/cli.target service)
                                          (\ file.default separator)
                                          "program"
                                          extension)])]
                  (..declare_success! []))
            (io.io []))))))