- WIP: - Initial PHP back-end implementation.

9 files changed, 1107 insertions, 0 deletions

diff --git a/new-luxc/source/luxc/lang/translation/php.lux b/new-luxc/source/luxc/lang/translation/php.lux
new file mode 100644
index 000000000..4cfcaaa0f
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/php.lux
@@ -0,0 +1,214 @@
+(.module:
+  lux
+  (lux (control ["ex" exception #+ exception:]
+                pipe
+                [monad #+ do])
+       (data [bit]
+             [maybe]
+             ["e" error #+ Error]
+             [text "text/" Eq<Text>]
+             text/format
+             (coll [array]))
+       [macro]
+       [io #+ IO Process io]
+       [host #+ class: interface: object]
+       (world [file #+ File]))
+  (luxc [lang]
+        (lang [".L" variable #+ Register]
+              ["ls" synthesis #+ Synthesis]
+              (host ["_" php #+ Expression Statement]))
+        [".C" io]))
+
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [No-Active-Module-Buffer]
+  [Cannot-Execute]
+
+  [No-Anchor]
+  )
+
+(host.import java/lang/Object)
+
+(host.import java/lang/String
+  (getBytes [String] #try (Array byte)))
+
+(host.import java/lang/CharSequence)
+
+(host.import java/lang/Appendable
+  (append [CharSequence] Appendable))
+
+(host.import java/lang/StringBuilder
+  (new [])
+  (toString [] String))
+
+(host.import javax/script/ScriptEngine
+  (eval [String] #try Object))
+
+(host.import javax/script/ScriptEngineManager
+  (new [])
+  (getEngineByName [String] ScriptEngine))
+
+(type: #export Anchor [Text Register])
+
+(type: #export Host
+  {#context [Text Nat]
+   #anchor (Maybe Anchor)
+   #loader (-> Statement (Error Unit))
+   #interpreter (-> Expression (Error Object))
+   #module-buffer (Maybe StringBuilder)
+   #program-buffer StringBuilder})
+
+(def: #export init
+  (IO Host)
+  (io (let [interpreter (|> (ScriptEngineManager::new [])
+                            (ScriptEngineManager::getEngineByName ["jphp"]))]
+        {#context ["" +0]
+         #anchor #.None
+         #loader (function (_ code)
+                   (do e.Monad<Error>
+                     [_ (ScriptEngine::eval [(format "<?php " (_.statement code))] interpreter)]
+                     (wrap [])))
+         #interpreter (function (_ code)
+                        (ScriptEngine::eval [(format "<?php " (_.statement (_.return! code)))] interpreter))
+         #module-buffer #.None
+         #program-buffer (StringBuilder::new [])})))
+
+(def: #export extension Text ".php")
+(def: #export module-name Text (format "module" extension))
+
+(def: #export init-module-buffer
+  (Meta Unit)
+  (function (_ compiler)
+    (#e.Success [(update@ #.host
+                          (|>> (:! Host)
+                               (set@ #module-buffer (#.Some (StringBuilder::new [])))
+                               (:! Void))
+                          compiler)
+                 []])))
+
+(def: #export (with-sub-context expr)
+  (All [a] (-> (Meta a) (Meta [Text a])))
+  (function (_ compiler)
+    (let [old (:! Host (get@ #.host compiler))
+          [old-name old-sub] (get@ #context old)
+          new-name (format old-name "___" (%i (nat-to-int old-sub)))]
+      (case (expr (set@ #.host
+                        (:! Void (set@ #context [new-name +0] old))
+                        compiler))
+        (#e.Success [compiler' output])
+        (#e.Success [(update@ #.host
+                              (|>> (:! Host)
+                                   (set@ #context [old-name (n/inc old-sub)])
+                                   (:! Void))
+                              compiler')
+                     [new-name output]])
+
+        (#e.Error error)
+        (#e.Error error)))))
+
+(def: #export context
+  (Meta Text)
+  (function (_ compiler)
+    (#e.Success [compiler
+                 (|> (get@ #.host compiler)
+                     (:! Host)
+                     (get@ #context)
+                     (let> [name sub]
+                           name))])))
+
+(def: #export (with-anchor anchor expr)
+  (All [a] (-> Anchor (Meta a) (Meta a)))
+  (function (_ compiler)
+    (let [old (:! Host (get@ #.host compiler))]
+      (case (expr (set@ #.host
+                        (:! Void (set@ #anchor (#.Some anchor) old))
+                        compiler))
+        (#e.Success [compiler' output])
+        (#e.Success [(update@ #.host
+                              (|>> (:! Host)
+                                   (set@ #anchor (get@ #anchor old))
+                                   (:! Void))
+                              compiler')
+                     output])
+
+        (#e.Error error)
+        (#e.Error error)))))
+
+(def: #export anchor
+  (Meta Anchor)
+  (function (_ compiler)
+    (case (|> compiler (get@ #.host) (:! Host) (get@ #anchor))
+      (#.Some anchor)
+      (#e.Success [compiler anchor])
+
+      #.None
+      ((lang.throw No-Anchor "") compiler))))
+
+(def: #export module-buffer
+  (Meta StringBuilder)
+  (function (_ compiler)
+    (case (|> compiler (get@ #.host) (:! Host) (get@ #module-buffer))
+      #.None
+      ((lang.throw No-Active-Module-Buffer "") compiler)
+      
+      (#.Some module-buffer)
+      (#e.Success [compiler module-buffer]))))
+
+(def: #export program-buffer
+  (Meta StringBuilder)
+  (function (_ compiler)
+    (#e.Success [compiler (|> compiler (get@ #.host) (:! Host) (get@ #program-buffer))])))
+
+(do-template [<name> <field> <inputT> <outputT>]
+  [(def: (<name> code)
+     (-> <inputT> (Meta <outputT>))
+     (function (_ compiler)
+       (let [runner (|> compiler (get@ #.host) (:! Host) (get@ <field>))]
+         (case (runner code)
+           (#e.Error error)
+           (exec (log! (:! Text code))
+             ((lang.throw Cannot-Execute error) compiler))
+           
+           (#e.Success output)
+           (#e.Success [compiler output])))))]
+
+  [load!     #loader      Statement  Unit]
+  [interpret #interpreter Expression Object]
+  )
+
+(def: #export variant-tag-field "_lux_tag")
+(def: #export variant-flag-field "_lux_flag")
+(def: #export variant-value-field "_lux_value")
+
+(def: #export unit Text "")
+
+(def: #export (definition-name [module name])
+  (-> Ident Text)
+  (lang.normalize-name (format module "$" name)))
+
+(def: #export (save code)
+  (-> Statement (Meta Unit))
+  (do macro.Monad<Meta>
+    [module-buffer module-buffer
+     #let [_ (Appendable::append [(:! CharSequence (_.statement code))]
+                                 module-buffer)]]
+    (load! code)))
+
+(def: #export (save-module! target)
+  (-> File (Meta (Process Unit)))
+  (do macro.Monad<Meta>
+    [module macro.current-module-name
+     module-buffer module-buffer
+     program-buffer program-buffer
+     #let [module-code (StringBuilder::toString [] module-buffer)
+           _ (Appendable::append [(:! CharSequence (format module-code "\n"))]
+                                 program-buffer)]]
+    (wrap (ioC.write target
+                     (format (lang.normalize-name module) "/" ..module-name)
+                     (|> module-code
+                         (String::getBytes ["UTF-8"])
+                         e.assume)))))
+
+(type: #export Translator (-> Synthesis (Meta Expression)))
diff --git a/new-luxc/source/luxc/lang/translation/php/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/php/eval.jvm.lux
new file mode 100644
index 000000000..ba9220f57
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/php/eval.jvm.lux
@@ -0,0 +1,147 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [bit]
+             [maybe]
+             ["e" error #+ Error]
+             text/format
+             (coll [array]))
+       [host])
+  (luxc [lang]
+        (lang (host ["_" php #+ Expression Statement])))
+  [//])
+
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [Not-A-Variant]
+  [Null-Has-No-Lux-Representation]
+  [Cannot-Evaluate]
+  )
+
+(host.import java/lang/Object
+  (toString [] String)
+  (getClass [] (Class Object)))
+
+(host.import java/lang/Long
+  (intValue [] Integer))
+
+(exception: #export (Unknown-Kind-Of-Host-Object {host-object Object})
+  (let [object-class (:! Text (Object::toString [] (Object::getClass [] (:! Object host-object))))
+        text-representation (:! Text (Object::toString [] (:! Object host-object)))]
+    (format object-class " --- " text-representation)))
+
+(host.import php/runtime/Memory)
+
+(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 [String])
+  (toString [] String))
+
+(host.import php/runtime/memory/ReferenceMemory
+  (getValue [] Memory))
+
+(host.import php/runtime/memory/ArrayMemory
+  (size [] int)
+  (isMap [] boolean)
+  (get [Memory] Memory))
+
+(def: (tuple lux-object host-object)
+  (-> (-> Object (Error Top)) ArrayMemory (Error Top))
+  (let [size (ArrayMemory::size [] host-object)]
+    (loop [idx 0
+           output (: (Array Top) (array.new (:! Nat size)))]
+      (if (i/< size idx)
+        (let [value (|> host-object
+                        (ArrayMemory::get [(LongMemory::new [idx])])
+                        (:! ReferenceMemory) (ReferenceMemory::getValue []))]
+          (if (host.instance? php/runtime/memory/NullMemory value)
+            (recur (i/inc idx)
+                   (array.write (:! Nat idx) (host.null) output))
+            (do e.Monad<Error>
+              [lux-value (lux-object value)]
+              (recur (i/inc idx)
+                     (array.write (:! Nat idx) lux-value output)))))
+        (ex.return output)))))
+
+(def: (variant lux-object host-object)
+  (-> (-> Object (Error Top)) ArrayMemory (Error Top))
+  (do e.Monad<Error>
+    [variant-tag (lux-object (ArrayMemory::get [(StringMemory::new [//.variant-tag-field])] host-object))
+     variant-value (lux-object (ArrayMemory::get [(StringMemory::new [//.variant-value-field])] host-object))]
+    (wrap (: Top
+             [(Long::intValue [] (:! Long variant-tag))
+              (: Top
+                 (if (|> host-object
+                         (ArrayMemory::get [(StringMemory::new [//.variant-flag-field])])
+                         (:! ReferenceMemory)
+                         (ReferenceMemory::getValue [])
+                         (host.instance? php/runtime/memory/NullMemory))
+                   (host.null)
+                   ""))
+              variant-value]))))
+
+(def: (lux-object host-object)
+  (-> Object (Error Top))
+  (cond (host.instance? php/runtime/memory/FalseMemory host-object)
+        (ex.return false)
+
+        (host.instance? php/runtime/memory/TrueMemory host-object)
+        (ex.return true)
+
+        (host.instance? php/runtime/memory/LongMemory host-object)
+        (ex.return (LongMemory::toLong [] (:! LongMemory host-object)))
+
+        (host.instance? php/runtime/memory/DoubleMemory host-object)
+        (ex.return (DoubleMemory::toDouble [] (:! DoubleMemory host-object)))
+
+        (host.instance? php/runtime/memory/StringMemory host-object)
+        (ex.return (StringMemory::toString [] (:! StringMemory host-object)))
+
+        (host.instance? php/runtime/memory/ReferenceMemory host-object)
+        (lux-object (ReferenceMemory::getValue [] (:! ReferenceMemory host-object)))
+
+        (host.instance? php/runtime/memory/ArrayMemory host-object)
+        (if (ArrayMemory::isMap [] (:! ArrayMemory host-object))
+          (variant lux-object (:! ArrayMemory host-object))
+          (tuple lux-object (:! ArrayMemory host-object)))
+
+        ## else
+        (ex.throw Unknown-Kind-Of-Host-Object host-object)))
+
+(def: #export (eval code)
+  (-> Expression (Meta Top))
+  (function (_ compiler)
+    (let [interpreter (|> compiler (get@ #.host) (:! //.Host) (get@ #//.interpreter))]
+      (case (interpreter code)
+        (#e.Error error)
+        (exec (log! (format "eval #e.Error\n"
+                            "<< " (_.expression code) "\n"
+                            error))
+          ((lang.throw Cannot-Evaluate error) compiler))
+
+        (#e.Success output)
+        (case (lux-object output)
+          (#e.Success parsed-output)
+          (exec ## (log! (format "eval #e.Success\n"
+            ##               "<< " (_.expression code)))
+            (#e.Success [compiler parsed-output]))
+
+          (#e.Error error)
+          (exec (log! (format "eval #e.Error\n"
+                              "<< " (_.expression code) "\n"
+                              error))
+            ((lang.throw Cannot-Evaluate error) compiler)))))))
diff --git a/new-luxc/source/luxc/lang/translation/php/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/php/expression.jvm.lux
new file mode 100644
index 000000000..abcc22187
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/php/expression.jvm.lux
@@ -0,0 +1,82 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
+                ["p" parser])
+       (data ["e" error]
+             text/format)
+       [macro]
+       (macro ["s" syntax]))
+  (luxc ["&" lang]
+        (lang [".L" variable #+ Variable Register]
+              [".L" extension]
+              ["ls" synthesis #+ Synthesis]
+              (host ["_" php #+ Expression Statement])))
+  [//]
+  (// [".T" runtime]
+      [".T" primitive]
+      [".T" structure]
+      [".T" reference]
+      [".T" function]
+      ## [".T" case]
+      ## [".T" procedure]
+      ))
+
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [Invalid-Function-Syntax]
+  [Unrecognized-Synthesis]
+  )
+
+(def: #export (translate synthesis)
+  //.Translator
+  (case synthesis
+    (^template [<tag> <generator>]
+      [_ (<tag> value)]
+      (|> value <generator>))
+    ([#.Bool primitiveT.translate-bool]
+     [#.Nat  (<| primitiveT.translate-int (:! Int))]
+     [#.Int  primitiveT.translate-int]
+     [#.Deg  (<| primitiveT.translate-int (:! Int))]
+     [#.Frac primitiveT.translate-frac]
+     [#.Text primitiveT.translate-text])
+
+    (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bool last?)]) (~ valueS)))
+    (structureT.translate-variant translate tag last? valueS)
+
+    (^code [(~+ members)])
+    (structureT.translate-tuple translate members)
+
+    (^ [_ (#.Form (list [_ (#.Int var)]))])
+    (referenceT.translate-variable var)
+
+    [_ (#.Symbol definition)]
+    (referenceT.translate-definition definition)
+
+    ## (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS)))
+    ## (caseT.translate-let translate register inputS exprS)
+
+    ## (^code ("lux case" (~ inputS) (~ pathPS)))
+    ## (caseT.translate-case translate inputS pathPS)
+
+    (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
+    (case (s.run environment (p.some s.int))
+      (#e.Success environment)
+      (functionT.translate-function translate environment arity bodyS)
+
+      _
+      (&.throw Invalid-Function-Syntax (%code synthesis)))
+
+    (^code ("lux call" (~ functionS) (~+ argsS)))
+    (functionT.translate-apply translate functionS argsS)
+
+    ## (^code ((~ [_ (#.Text procedure)]) (~+ argsS)))
+    ## (procedureT.translate-procedure translate procedure argsS)
+    ## (do macro.Monad<Meta>
+    ##   [translation (extensionL.find-translation procedure)]
+    ##   (translation argsS))
+
+    _
+    (&.throw Unrecognized-Synthesis (%code synthesis))))
diff --git a/new-luxc/source/luxc/lang/translation/php/function.jvm.lux b/new-luxc/source/luxc/lang/translation/php/function.jvm.lux
new file mode 100644
index 000000000..7d0baa4d5
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/php/function.jvm.lux
@@ -0,0 +1,81 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                pipe)
+       (data [product]
+             [text]
+             text/format
+             (coll [list "list/" Functor<List> Fold<List>]))
+       [macro])
+  (luxc ["&" lang]
+        (lang ["ls" synthesis #+ Synthesis Arity]
+              [".L" variable #+ Register Variable]
+              (host ["_" php #+ Expression GExpression CExpression Statement])))
+  [//]
+  (// [".T" reference]))
+
+(def: #export (translate-apply translate functionS argsS+)
+  (-> //.Translator Synthesis (List Synthesis) (Meta CExpression))
+  (do macro.Monad<Meta>
+    [functionO (translate functionS)
+     argsO+ (monad.map @ translate argsS+)]
+    (wrap (_.apply argsO+ functionO))))
+
+(def: @curried (_.var "curried"))
+
+(def: (input-declaration! register)
+  (-> Register Statement)
+  (_.set! (referenceT.variable (n/inc register))
+          (_.nth (|> register nat-to-int _.int)
+                 @curried)))
+
+(def: (with-closure @function inits function-definition!)
+  (-> GExpression (List Expression) Statement (Meta Expression))
+  (case inits
+    #.Nil
+    (do macro.Monad<Meta>
+      [_ (//.save function-definition!)]
+      (wrap @function))
+
+    _
+    (do macro.Monad<Meta>
+      []
+      (wrap (_.apply inits
+                     (_.function (|> (list.enumerate inits)
+                                     (list/map (|>> product.left referenceT.closure)))
+                       (|> function-definition!
+                           (_.then! (_.return! @function)))))))))
+
+(def: #export (translate-function translate env arity bodyS)
+  (-> //.Translator (List Variable) Arity Synthesis (Meta Expression))
+  (do macro.Monad<Meta>
+    [[function-name bodyO] (//.with-sub-context
+                             (do @
+                               [function-name //.context]
+                               (//.with-anchor [function-name +1]
+                                 (translate bodyS))))
+     closureO+ (monad.map @ referenceT.translate-variable env)
+     #let [@function (_.global function-name)
+           self-init! (_.set! (referenceT.variable +0) @function)
+           args-inits! (|> (list.n/range +0 (n/dec arity))
+                           (list/map input-declaration!)
+                           (list/fold _.then! self-init!))
+           arityO (|> arity nat-to-int _.int)
+           @num_args (_.var "num_args")]]
+    (with-closure @function closureO+
+      (_.function! @function (list)
+                   (|> (_.set! @num_args _.func-num-args/0)
+                       (_.then! (_.set! @curried _.func-get-args/0))
+                       (_.then! (_.if! (|> @num_args (_.= arityO))
+                                       (|> args-inits!
+                                           (_.then! (_.return! bodyO)))
+                                       (_.if! (|> @num_args (_.> arityO))
+                                              (let [arity-args (_.array-slice/3 @curried (_.int 0) arityO)
+                                                    output-func-args (_.array-slice/2 @curried arityO)]
+                                                (_.return! (_.call-user-func-array/2 (_.call-user-func-array/2 @function arity-args)
+                                                                                     output-func-args)))
+                                              (let [@missing (_.var "missing")]
+                                                (_.return! (_.function (list)
+                                                             (|> (_.set! @missing _.func-get-args/0)
+                                                                 (_.then! (_.return! (_.call-user-func-array/2 @function
+                                                                                                               (_.array-merge/+ @curried (list @missing)))))))))))))))))
diff --git a/new-luxc/source/luxc/lang/translation/php/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/php/primitive.jvm.lux
new file mode 100644
index 000000000..61570143b
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/php/primitive.jvm.lux
@@ -0,0 +1,20 @@
+(.module:
+  lux
+  (lux [macro "meta/" Monad<Meta>])
+  (luxc (lang (host ["_" php #+ CExpression]))))
+
+(def: #export translate-bool
+  (-> Bool (Meta CExpression))
+  (|>> _.bool meta/wrap))
+
+(def: #export translate-int
+  (-> Int (Meta CExpression))
+  (|>> _.int meta/wrap))
+
+(def: #export translate-frac
+  (-> Frac (Meta CExpression))
+  (|>> _.float meta/wrap))
+
+(def: #export translate-text
+  (-> Text (Meta CExpression))
+  (|>> _.string meta/wrap))
diff --git a/new-luxc/source/luxc/lang/translation/php/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/php/reference.jvm.lux
new file mode 100644
index 000000000..280710afc
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/php/reference.jvm.lux
@@ -0,0 +1,37 @@
+(.module:
+  lux
+  (lux [macro]
+       (data [text]
+             text/format))
+  (luxc ["&" lang]
+        (lang [".L" variable #+ Variable Register]
+              (host ["_" php #+ VExpression])))
+  [//]
+  (// [".T" runtime]))
+
+(do-template [<register> <prefix>]
+  [(def: #export <register>
+     (-> Register VExpression)
+     (|>> (:! Int) %i (format <prefix>) _.var))]
+
+  [closure  "c"]
+  [variable "v"])
+
+(def: #export (local var)
+  (-> Variable VExpression)
+  (if (variableL.captured? var)
+    (closure (variableL.captured-register var))
+    (variable (:! Nat var))))
+
+(def: #export global
+  (-> Ident VExpression)
+  (|>> //.definition-name _.var))
+
+(do-template [<name> <input> <converter>]
+  [(def: #export <name>
+     (-> <input> (Meta VExpression))
+     (|>> <converter> (:: macro.Monad<Meta> wrap)))]
+
+  [translate-variable   Variable local]
+  [translate-definition Ident    global]
+  )
diff --git a/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux
new file mode 100644
index 000000000..d2f5cd2a2
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux
@@ -0,0 +1,447 @@
+(.module:
+  lux
+  (lux (control ["p" parser "p/" Monad<Parser>]
+                [monad #+ do])
+       (data text/format
+             (coll [list "list/" Monad<List>]))
+       [macro]
+       (macro [code]
+              ["s" syntax #+ syntax:])
+       [io #+ Process])
+  [//]
+  (luxc [lang]
+        (lang (host ["_" php #+ Expression CExpression Statement]))))
+
+(def: prefix Text "LuxRuntime")
+
+(def: #export unit CExpression (_.string //.unit))
+
+(def: (flag value)
+  (-> Bool CExpression)
+  (if value
+    (_.string "")
+    _.null))
+
+(def: (variant' tag last? value)
+  (-> Expression Expression Expression CExpression)
+  (_.array/** (list [(_.string //.variant-tag-field) tag]
+                    [(_.string //.variant-flag-field) last?]
+                    [(_.string //.variant-value-field) value])))
+
+(def: #export (variant tag last? value)
+  (-> Nat Bool Expression CExpression)
+  (variant' (_.int (nat-to-int tag))
+            (flag last?)
+            value))
+
+(def: #export none
+  CExpression
+  (variant +0 false unit))
+
+(def: #export some
+  (-> Expression CExpression)
+  (variant +1 true))
+
+(def: #export left
+  (-> Expression CExpression)
+  (variant +0 false))
+
+(def: #export right
+  (-> Expression CExpression)
+  (variant +1 true))
+
+(type: Runtime Statement)
+
+## (def: declaration
+##   (s.Syntax [Text (List Text)])
+##   (p.either (p.seq s.local-symbol (p/wrap (list)))
+##             (s.form (p.seq s.local-symbol (p.some s.local-symbol)))))
+
+## (syntax: (runtime: [[name args] declaration]
+##            definition)
+##   (let [implementation (code.local-symbol (format "@@" name))
+##         runtime (format "__" prefix "__" (lang.normalize-name name))
+##         $runtime (` (_.var (~ (code.text runtime))))
+##         @runtime (` (@@ (~ $runtime)))
+##         argsC+ (list/map code.local-symbol args)
+##         argsLC+ (list/map (|>> lang.normalize-name code.text (~) (_.var) (`))
+##                           args)
+##         declaration (` ((~ (code.local-symbol name))
+##                         (~+ argsC+)))
+##         type (` (-> (~+ (list.repeat (list.size argsC+) (` _.Expression)))
+##                     _.CExpression))]
+##     (wrap (list (` (def: (~' #export) (~ declaration)
+##                      (~ type)
+##                      (_.apply (list (~+ argsC+)) (~ @runtime))))
+##                 (` (def: (~ implementation)
+##                      _.Statement
+##                      (~ (case argsC+
+##                           #.Nil
+##                           (` (_.set! (list (~ $runtime)) (~ definition)))
+
+##                           _
+##                           (` (let [(~+ (|> (list.zip2 argsC+ argsLC+)
+##                                            (list/map (function (_ [left right])
+##                                                        (list left (` (@@ (~ right))))))
+##                                            list/join))]
+##                                (_.def! (~ $runtime)
+##                                        (list (~+ argsLC+))
+##                                        (~ definition))))))))))))
+
+## (syntax: (with-vars [vars (s.tuple (p.many s.local-symbol))]
+##            body)
+##   (wrap (list (` (let [(~+ (|> vars
+##                                (list/map (function (_ var)
+##                                            (list (code.local-symbol var)
+##                                                  (` (_.var (~ (code.text (lang.normalize-name var))))))))
+##                                list/join))]
+##                    (~ body))))))
+
+## (runtime: (lux//try op)
+##   (let [$error (_.var "error")
+##         $value (_.var "value")]
+##     (_.try! ($_ _.then!
+##                 (_.set! (list $value) (_.apply (list unit) op))
+##                 (_.return! (right (@@ $value))))
+##             (list [(list "Exception") $error
+##                    (_.return! (left (_.apply (list (@@ $error)) (_.global "str"))))]))))
+
+## (runtime: (lux//program-args program-args)
+##   (let [$inputs (_.var "inputs")
+##         $value (_.var "value")]
+##     ($_ _.then!
+##         (_.set! (list $inputs) none)
+##         (<| (_.for-in! $value program-args)
+##             (_.set! (list $inputs)
+##                     (some (_.tuple (list (@@ $value) (@@ $inputs))))))
+##         (_.return! (@@ $inputs)))))
+
+## (def: runtime//lux
+##   Runtime
+##   ($_ _.then!
+##       @@lux//try
+##       @@lux//program-args))
+
+## (runtime: (io//log! message)
+##   ($_ _.then!
+##       (_.print! message)
+##       (_.return! ..unit)))
+
+## (def: (exception message)
+##   (-> Expression CExpression)
+##   (_.apply (list message) (_.global "Exception")))
+
+## (runtime: (io//throw! message)
+##   ($_ _.then!
+##       (_.raise! (exception message))
+##       (_.return! ..unit)))
+
+## (runtime: (io//exit! code)
+##   ($_ _.then!
+##       (_.import! "sys")
+##       (_.do! (|> (_.global "sys") (_.send (list code) "exit")))
+##       (_.return! ..unit)))
+
+## (runtime: (io//current-time! _)
+##   ($_ _.then!
+##       (_.import! "time")
+##       (_.return! (let [time (|> (_.global "time")
+##                                 (_.send (list) "time")
+##                                 (_.* (_.int 1_000)))]
+##                    (_.apply (list time) (_.global "int"))))))
+
+## (def: runtime//io
+##   Runtime
+##   ($_ _.then!
+##       @@io//log!
+##       @@io//throw!
+##       @@io//exit!
+##       @@io//current-time!))
+
+## (runtime: (product//left product index)
+##   (let [$index_min_length (_.var "index_min_length")]
+##     ($_ _.then!
+##         (_.set! (list $index_min_length) (_.+ (_.int 1) index))
+##         (_.if! (_.> (@@ $index_min_length) (_.length product))
+##                ## No need for recursion
+##                (_.return! (_.nth index product))
+##                ## Needs recursion
+##                (_.return! (product//left (_.nth (_.- (_.int 1)
+##                                                      (_.length product))
+##                                                 product)
+##                                          (_.- (_.length product)
+##                                               (@@ $index_min_length))))))))
+
+## (runtime: (product//right product index)
+##   (let [$index_min_length (_.var "index_min_length")]
+##     ($_ _.then!
+##         (_.set! (list $index_min_length) (_.+ (_.int 1) index))
+##         (_.cond! (list [(_.= (@@ $index_min_length) (_.length product))
+##                         ## Last element.
+##                         (_.return! (_.nth index product))]
+##                        [(_.< (@@ $index_min_length) (_.length product))
+##                         ## Needs recursion
+##                         (_.return! (product//right (_.nth (_.- (_.int 1)
+##                                                                (_.length product))
+##                                                           product)
+##                                                    (_.- (_.length product)
+##                                                         (@@ $index_min_length))))])
+##                  ## Must slice
+##                  (_.return! (_.slice-from index product))))))
+
+## (runtime: (sum//get sum wantedTag wantsLast)
+##   (let [no-match! (_.return! _.none)
+##         sum-tag (_.nth (_.string //.variant-tag-field) sum)
+##         sum-flag (_.nth (_.string //.variant-flag-field) sum)
+##         sum-value (_.nth (_.string //.variant-value-field) sum)
+##         is-last? (_.= (_.string "") sum-flag)
+##         test-recursion! (_.if! is-last?
+##                                ## Must recurse.
+##                                (_.return! (sum//get sum-value (_.- sum-tag wantedTag) wantsLast))
+##                                no-match!)]
+##     (_.cond! (list [(_.= sum-tag wantedTag)
+##                     (_.if! (_.= wantsLast sum-flag)
+##                            (_.return! sum-value)
+##                            test-recursion!)]
+
+##                    [(_.> sum-tag wantedTag)
+##                     test-recursion!]
+
+##                    [(_.and (_.< sum-tag wantedTag)
+##                            (_.= (_.string "") wantsLast))
+##                     (_.return! (variant' (_.- wantedTag sum-tag) sum-flag sum-value))])
+
+##              no-match!)))
+
+## (def: runtime//adt
+##   Runtime
+##   ($_ _.then!
+##       @@product//left
+##       @@product//right
+##       @@sum//get))
+
+## (def: full-32-bits (_.code "0xFFFFFFFF"))
+
+## (runtime: (bit//32 input)
+##   (with-vars [capped]
+##     (_.cond! (list [(|> input (_.> full-32-bits))
+##                     (_.return! (|> input (_.bit-and full-32-bits) bit//32))]
+##                    [(|> input (_.> (_.code "0x7FFFFFFF")))
+##                     ($_ _.then!
+##                         (_.set! (list capped)
+##                                 (_.apply (list (|> (_.code "0x100000000")
+##                                                    (_.- input)))
+##                                          (_.global "int")))
+##                         (_.if! (|> (@@ capped) (_.<= (_.int 2147483647)))
+##                                (_.return! (|> (@@ capped) (_.* (_.int -1))))
+##                                (_.return! (_.int -2147483648))))])
+##              (_.return! input))))
+
+## (def: full-64-bits (_.code "0xFFFFFFFFFFFFFFFF"))
+
+## (runtime: (bit//64 input)
+##   (with-vars [capped]
+##     (_.cond! (list [(|> input (_.> full-64-bits))
+##                     (_.return! (|> input (_.bit-and full-64-bits) bit//64))]
+##                    [(|> input (_.> (_.code "0x7FFFFFFFFFFFFFFF")))
+##                     ($_ _.then!
+##                         (_.set! (list capped)
+##                                 (_.apply (list (|> (_.code "0x10000000000000000")
+##                                                    (_.- input)))
+##                                          (_.global "int")))
+##                         (_.if! (|> (@@ capped) (_.<= (_.code "9223372036854775807L")))
+##                                (_.return! (|> (@@ capped) (_.* (_.int -1))))
+##                                (_.return! (_.code "-9223372036854775808L"))))])
+##              (_.return! input))))
+
+## (runtime: (bit//shift-right param subject)
+##   (let [mask (|> (_.int 1)
+##                  (_.bit-shl (_.- param (_.int 64)))
+##                  (_.- (_.int 1)))]
+##     (_.return! (|> subject
+##                    (_.bit-shr param)
+##                    (_.bit-and mask)))))
+
+## (def: runtime//bit
+##   Runtime
+##   ($_ _.then!
+##       @@bit//32
+##       @@bit//64
+##       @@bit//shift-right))
+
+## (runtime: (text//index subject param start)
+##   (with-vars [idx]
+##     ($_ _.then!
+##         (_.set! (list idx) (_.send (list param start) "find" subject))
+##         (_.if! (_.= (_.int -1) (@@ idx))
+##                (_.return! ..none)
+##                (_.return! (..some (@@ idx)))))))
+
+## (def: inc (|>> (_.+ (_.int 1))))
+
+## (do-template [<name> <top-cmp>]
+##   [(def: (<name> top value)
+##      (-> Expression Expression Expression)
+##      (_.and (|> value (_.>= (_.int 0)))
+##             (|> value (<top-cmp> top))))]
+
+##   [within? _.<]
+##   [up-to?  _.<=]
+##   )
+
+## (runtime: (text//clip @text @from @to)
+##   (with-vars [length]
+##     ($_ _.then!
+##         (_.set! (list length) (_.length @text))
+##         (_.if! ($_ _.and
+##                    (|> @to (within? (@@ length)))
+##                    (|> @from (up-to? @to)))
+##                (_.return! (..some (|> @text (_.slice @from (inc @to)))))
+##                (_.return! ..none)))))
+
+## (runtime: (text//char text idx)
+##   (_.if! (|> idx (within? (_.length text)))
+##          (_.return! (..some (_.apply (list (|> text (_.slice idx (inc idx))))
+##                                      (_.global "ord"))))
+##          (_.return! ..none)))
+
+## (def: runtime//text
+##   Runtime
+##   ($_ _.then!
+##       @@text//index
+##       @@text//clip
+##       @@text//char))
+
+## (def: (check-index-out-of-bounds array idx body!)
+##   (-> Expression Expression Statement Statement)
+##   (_.if! (|> idx (_.<= (_.length array)))
+##          body!
+##          (_.raise! (exception (_.string "Array index out of bounds!")))))
+
+## (runtime: (array//get array idx)
+##   (with-vars [temp]
+##     (<| (check-index-out-of-bounds array idx)
+##         ($_ _.then!
+##             (_.set! (list temp) (_.nth idx array))
+##             (_.if! (_.= _.none (@@ temp))
+##                    (_.return! ..none)
+##                    (_.return! (..some (@@ temp))))))))
+
+## (runtime: (array//put array idx value)
+##   (<| (check-index-out-of-bounds array idx)
+##       ($_ _.then!
+##           (_.set-nth! idx value array)
+##           (_.return! array))))
+
+## (def: runtime//array
+##   Runtime
+##   ($_ _.then!
+##       @@array//get
+##       @@array//put))
+
+## (def: #export atom//field Text "_lux_atom")
+
+## (runtime: (atom//compare-and-swap atom old new)
+##   (let [atom//field (_.string atom//field)]
+##     (_.if! (_.= old (_.nth atom//field atom))
+##            ($_ _.then!
+##                (_.set-nth! atom//field new atom)
+##                (_.return! (_.bool true)))
+##            (_.return! (_.bool false)))))
+
+## (def: runtime//atom
+##   Runtime
+##   ($_ _.then!
+##       @@atom//compare-and-swap))
+
+## (runtime: (box//write value box)
+##   ($_ _.then!
+##       (_.set-nth! (_.int 0) value box)
+##       (_.return! ..unit)))
+
+## (def: runtime//box
+##   Runtime
+##   ($_ _.then!
+##       @@box//write))
+
+## (runtime: (process//future procedure)
+##   ($_ _.then!
+##       (_.import! "threading")
+##       (let [params (_.dict (list [(_.string "target") procedure]))]
+##         (_.do! (|> (_.global "threading")
+##                    (_.send-keyword (list) params "Thread")
+##                    (_.send (list) "start"))))
+##       (_.return! ..unit)))
+
+## (runtime: (process//schedule milli-seconds procedure)
+##   ($_ _.then!
+##       (_.import! "threading")
+##       (let [seconds (|> milli-seconds (_./ (_.float 1_000.0)))]
+##         (_.do! (|> (_.global "threading")
+##                    (_.send (list seconds procedure) "Timer")
+##                    (_.send (list) "start"))))
+##       (_.return! ..unit)))
+
+## (def: runtime//process
+##   Runtime
+##   ($_ _.then!
+##       @@process//future
+##       @@process//schedule))
+
+## (do-template [<name> <method>]
+##   [(runtime: (<name> input)
+##      ($_ _.then!
+##          (_.import! "math")
+##          (_.return! (|> (_.global "math") (_.send (list input) <method>)))))]
+
+##   [math//cos  "cos"]
+##   [math//sin  "sin"]
+##   [math//tan  "tan"]
+##   [math//acos "acos"]
+##   [math//asin "asin"]
+##   [math//atan "atan"]
+##   [math//exp  "exp"]
+##   [math//log  "log"]
+##   [math//ceil "ceil"]
+##   [math//floor "floor"]
+##   )
+
+## (def: runtime//math
+##   Runtime
+##   ($_ _.then!
+##       @@math//cos
+##       @@math//sin
+##       @@math//tan
+##       @@math//acos
+##       @@math//asin
+##       @@math//atan
+##       @@math//exp
+##       @@math//log
+##       @@math//ceil
+##       @@math//floor))
+
+(def: runtime
+  Runtime
+  (_.echo! (_.string "Hello, world!"))
+  ## ($_ _.then!
+  ##     runtime//lux
+  ##     runtime//adt
+  ##     runtime//bit
+  ##     runtime//text
+  ##     runtime//array
+  ##     runtime//atom
+  ##     runtime//box
+  ##     runtime//io
+  ##     runtime//process
+  ##     runtime//math
+  ##     )
+  )
+
+(def: #export artifact Text (format prefix //.extension))
+
+(def: #export translate
+  (Meta (Process Unit))
+  (do macro.Monad<Meta>
+    [_ //.init-module-buffer
+     _ (//.save runtime)]
+    (//.save-module! artifact)))
diff --git a/new-luxc/source/luxc/lang/translation/php/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/php/statement.jvm.lux
new file mode 100644
index 000000000..592e579cf
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/php/statement.jvm.lux
@@ -0,0 +1,48 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       [macro]
+       (data text/format))
+  (luxc (lang [".L" module]
+              (host ["_" php #+ Expression Statement])))
+  [//]
+  (// [".T" runtime]
+      [".T" reference]
+      [".T" eval]))
+
+(def: #export (translate-def name expressionT expressionO metaV)
+  (-> Text Type Expression Code (Meta Unit))
+  (do macro.Monad<Meta>
+    [current-module macro.current-module-name
+     #let [def-ident [current-module name]]]
+    (case (macro.get-symbol-ann (ident-for #.alias) metaV)
+      (#.Some real-def)
+      (do @
+        [[realT realA realV] (macro.find-def real-def)
+         _ (moduleL.define def-ident [realT metaV realV])]
+        (wrap []))
+
+      _
+      (do @
+        [#let [def-name (referenceT.global def-ident)]
+         _ (//.save (_.set! def-name expressionO))
+         expressionV (evalT.eval def-name)
+         _ (moduleL.define def-ident [expressionT metaV expressionV])
+         _ (if (macro.type? metaV)
+             (case (macro.declared-tags metaV)
+               #.Nil
+               (wrap [])
+
+               tags
+               (moduleL.declare-tags tags (macro.export? metaV) (:! Type expressionV)))
+             (wrap []))
+         #let [_ (log! (format "DEF " (%ident def-ident)))]]
+        (wrap []))
+      )))
+
+(def: #export (translate-program programO)
+  (-> Expression (Meta Statement))
+  (macro.fail "translate-program NOT IMPLEMENTED YET")
+  ## (hostT.save (format "var " (referenceT.variable +0) " = " runtimeT.lux//program-args "();"
+  ##                     "(" programO ")(null);"))
+  )
diff --git a/new-luxc/source/luxc/lang/translation/php/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/php/structure.jvm.lux
new file mode 100644
index 000000000..6e44f3973
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/php/structure.jvm.lux
@@ -0,0 +1,31 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format)
+       [macro])
+  (luxc ["&" lang]
+        (lang [synthesis #+ Synthesis]
+              (host ["_" php #+ Expression CExpression])))
+  [//]
+  (// [".T" runtime]))
+
+(def: #export (translate-tuple translate elemsS+)
+  (-> //.Translator (List Synthesis) (Meta Expression))
+  (case elemsS+
+    #.Nil
+    (:: macro.Monad<Meta> wrap runtimeT.unit)
+
+    (#.Cons singletonS #.Nil)
+    (translate singletonS)
+
+    _
+    (do macro.Monad<Meta>
+      [elemsT+ (monad.map @ translate elemsS+)]
+      (wrap (_.array/* elemsT+)))))
+
+(def: #export (translate-variant translate tag tail? valueS)
+  (-> //.Translator Nat Bool Synthesis (Meta CExpression))
+  (do macro.Monad<Meta>
+    [valueT (translate valueS)]
+    (wrap (runtimeT.variant tag tail? valueT))))