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

(.module:
  [lux #*
   [abstract
    ["." monad (#+ do)]]
   [control
    pipe
    ["." exception (#+ exception:)]
    ["." io (#+ IO io)]
    ["p" parser
     [cli (#+ program:)]]]
   [data
    ["." maybe]
    ["." error (#+ Error)]
    [number
     ["." i64]]
    ["." text ("#@." hash)
     format]
    [collection
     ["." array (#+ Array)]
     ["." list ("#@." functor)]]]
   [macro
    ["." template]]
   [world
    ["." file]]
   ["." host (#+ import: interface: do-to object)
    ["_" php]]
   [tool
    [compiler
     ["." name]
     ["." synthesis]
     [phase
      [macro (#+ Expander)]
      ["." generation
       ["." php
        ["." runtime]
        ["." extension]]]]
     [default
      ["." platform (#+ Platform)]]]]
   ["." debug]]
  [program
   ["/" compositor
    ["/." cli]]])

(import: #long java/lang/String)

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

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

(import: #long java/lang/Integer)

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

(import: #long php/runtime/Memory)

(import: #long php/runtime/Memory$Type
  (#enum ARRAY))

(import: #long php/runtime/memory/NullMemory)

(import: #long php/runtime/memory/FalseMemory)
(import: #long php/runtime/memory/TrueMemory)

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

(import: #long php/runtime/memory/DoubleMemory
  (toDouble [] double))

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

(import: #long php/runtime/memory/ReferenceMemory
  (getValue [] php/runtime/Memory))

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

(import: #long php/runtime/lang/IObject)

(import: #long php/runtime/memory/ObjectMemory
  (value php/runtime/lang/IObject))

(import: #long php/runtime/env/Environment
  (#static current [] php/runtime/env/Environment))

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

(import: #long php/runtime/reflection/FunctionEntity)

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

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

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

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

  [StructureValue]
  )

(type: Reader
  (-> java/lang/Object (Error 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)
  (`` (object [] php/runtime/Memory ## php/runtime/memory/ArrayMemory
        [program/StructureValue]
        [{php/runtime/Memory$Type php/runtime/Memory$Type::ARRAY}]
        ## Methods
        (program/StructureValue
         (getValue)
         java/lang/Object
         (:assume value))

        ## (php/runtime/memory/ArrayMemory
        ##  (size)
        ##  int
        ##  (exec
        ##    (log! "{lux-structure#size}")
        ##    (:assume (array.size value))))
        
        ## (php/runtime/memory/ArrayMemory
        ##  (get {key php/runtime/Memory})
        ##  php/runtime/Memory
        ##  (exec
        ##    (log! (format "{lux-structure#get}" text.new-line
        ##                  (exception.construct unknown-kind-of-object key)))
        ##    (error! "OOPS!")))

        ## (php/runtime/memory/ArrayMemory
        ##  (getOrCreate {key php/runtime/Memory})
        ##  php/runtime/memory/ReferenceMemory
        ##  (exec
        ##    (log! (format "{lux-structure#getOrCreate}" text.new-line
        ##                  (exception.construct unknown-kind-of-object key)))
        ##    (error! "OOPS!")))

        ## (php/runtime/memory/ArrayMemory
        ##  (getOrCreateAsShortcut {key php/runtime/Memory})
        ##  php/runtime/memory/ReferenceMemory
        ##  (exec
        ##    (log! (format "{lux-structure#getOrCreateAsShortcut}" text.new-line
        ##                  (exception.construct unknown-kind-of-object key)))
        ##    (error! "OOPS!")))

        ## (php/runtime/memory/ArrayMemory
        ##  (getByScalarOrCreateAsShortcut {key java/lang/Object})
        ##  php/runtime/memory/ReferenceMemory
        ##  (exec
        ##    (log! (format "{lux-structure#getByScalarOrCreateAsShortcut}" text.new-line
        ##                  (exception.construct unknown-kind-of-object key)))
        ##    (error! "OOPS!")))

        ## (php/runtime/memory/ArrayMemory
        ##  (getByScalarOrCreate {key java/lang/Object})
        ##  php/runtime/memory/ReferenceMemory
        ##  (exec
        ##    (log! (format "{lux-structure#getByScalarOrCreate}" text.new-line
        ##                  (exception.construct unknown-kind-of-object key)))
        ##    (error! "OOPS!")))

        ## (php/runtime/memory/ArrayMemory
        ##  (getByScalar {key java/lang/Object})
        ##  php/runtime/memory/ReferenceMemory
        ##  (exec
        ##    (log! (format "{lux-structure#getByScalar}" text.new-line
        ##                  (exception.construct unknown-kind-of-object key)))
        ##    (error! "OOPS!")))

        (php/runtime/Memory
         (refOfIndex {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 {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 {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 {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>) php/runtime/Memory (undefined))]

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

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

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

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

(def: (read-tuple read host-object)
  (-> Reader php/runtime/memory/ArrayMemory (Error 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)
              (#error.Failure error)
              (#error.Failure error)

              (#error.Success lux-value)
              (recur (inc idx) (array.write idx lux-value output)))))
        (#error.Success output)))))

(def: (read-variant read host-object)
  (-> Reader php/runtime/memory/ArrayMemory (Error 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)]
    [(#error.Success tag) (#error.Success value)]
    (#error.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 _)
                   (#error.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 #error.Success]]
                [php/runtime/memory/DoubleMemory [php/runtime/memory/DoubleMemory::toDouble #error.Success]]
                [php/runtime/memory/StringMemory [php/runtime/memory/StringMemory::toString #error.Success]]
                [php/runtime/memory/ReferenceMemory [php/runtime/memory/ReferenceMemory::getValue read]]
                [php/runtime/memory/ObjectMemory [#error.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)]))

(import: #long javax/script/ScriptEngine
  (eval [String] #try Object))

(import: #long 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
      (Error (Error [Lux (List Code)])))
  (<| :assume
      (do error.monad
        [#let [_ (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 [_ (log! (format "{call-macro 1} " (debug.inspect output)))
               _ (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 "___")

(type: Host
  (generation.Host (_.Expression Any) _.Statement))

(def: host
  (IO Host)
  (io (let [interpreter (org/develnext/jphp/scripting/JPHPScriptEngine::new)
            run! (: (-> Text (_.Code Any) (Error Any))
                    (function (_ dummy-name code)
                      (do error.monad
                        [output (javax/script/ScriptEngine::eval (format "<?php " (_.code code)) interpreter)]
                        (..read output))))]
        (: Host
           (structure
            (def: (evaluate! dummy-name code)
              (run! dummy-name (_.return code)))
            
            (def: execute! run!)
            
            (def: (define! [module name] input)
              (let [global (format (text.replace-all .module-separator ..separator module)
                                   ..separator (name.normalize name)
                                   "___" (%n (text@hash name)))
                    @global (_.global global)]
                (do error.monad
                  [#let [definition (_.; (_.set @global input))]
                   _ (run! global definition)
                   value (run! global (_.return @global))]
                  (wrap [global value definition])))))))))

(def: platform
  (IO (Platform IO _.Var (_.Expression Any) _.Statement))
  (do io.monad
    [host ..host]
    (wrap {#platform.&monad io.monad
           #platform.&file-system file.system
           #platform.host host
           #platform.phase php.generate
           #platform.runtime runtime.generate})))

(def: (program program)
  (-> (_.Expression Any) _.Statement)
  (_.; (_.apply/2 [(runtime.lux//program-args _.command-line-arguments)
                   _.null]
                  program)))

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