Updates for Common-Lisp compiler.

2 files changed, 314 insertions, 185 deletions

diff --git a/lux-cl/commands.md b/lux-cl/commands.md
new file mode 100644
index 000000000..baefd65b7
--- /dev/null
+++ b/lux-cl/commands.md
@@ -0,0 +1,23 @@
+# Common Lisp compiler
+
+## Test
+
+```
+cd ~/lux/lux-cl/ && lein lux auto test
+cd ~/lux/lux-cl/ && lein clean && lein lux auto test
+```
+
+## Build
+
+```
+## Develop
+cd ~/lux/lux-cl/ \
+&& lein clean \
+&& lein lux auto build
+```
+
+## Try
+
+```
+cd ~/lux/lux-cl/ && java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux
+```
diff --git a/lux-cl/source/program.lux b/lux-cl/source/program.lux
index 8d6218297..89b2b937c 100644
--- a/lux-cl/source/program.lux
+++ b/lux-cl/source/program.lux
@@ -1,116 +1,151 @@
 (.module:
   [lux #*
-   ["." host (#+ import: interface: do-to object)]
+   [program (#+ program:)]
+   ["." ffi]
+   ["." debug]
    [abstract
-    [monad (#+ do)]]
+    ["." monad (#+ do)]]
    [control
-    [pipe (#+ new> case>)]
+    [pipe (#+ exec> case> new>)]
+    ["." try (#+ Try)]
     ["." exception (#+ exception:)]
     ["." io (#+ IO io)]
-    [parser
-     [cli (#+ program:)]]]
+    [concurrency
+     ["." promise (#+ Promise)]]]
    [data
     ["." maybe]
-    ["." error (#+ Error)]
-    [number
-     ["." i64]]
-    ["." text ("#/." hash)
-     format]
+    ["." text ("#\." hash)
+     ["%" format (#+ format)]
+     ["." encoding]]
     [collection
-     ["." array (#+ Array)]
-     ["." list ("#/." functor)]]]
+     ["." array (#+ Array)]]]
    [macro
     ["." template]]
-   [world
-    ["." file]]
-   ["." debug]
-   [target
-    ["_" common-lisp]]
+   [math
+    [number (#+ hex)
+     ["n" nat]
+     ["." i64]]]
+   ["." world #_
+    ["." file]
+    ["#/." program]]
+   ["@" target
+    ["_" common_lisp]]
    [tool
     [compiler
-     ["." name]
-     ["." synthesis]
-     [phase
-      [macro (#+ Expander)]
-      ["." generation
-       ["." common-lisp
-        ["." runtime]
-        ["." extension]]]]
+     [phase (#+ Operation Phase)]
+     [reference
+      [variable (#+ Register)]]
+     [language
+      [lux
+       [program (#+ Program)]
+       [generation (#+ Context Host)]
+       ["." synthesis]
+       [analysis
+        [macro (#+ Expander)]]
+       [phase
+        ["." extension (#+ Extender Handler)
+         ["#/." bundle]
+         ["." analysis #_
+          ["#" common_lisp]]
+         ["." generation #_
+          ["#" common_lisp]]]
+        [generation
+         ["." reference]
+         ["." common_lisp
+          ["." runtime]]]]]]
      [default
-      ["." platform (#+ Platform)]]]]]
+      ["." platform (#+ Platform)]]
+     [meta
+      ["." packager #_
+       ["#" script]]]]]]
   [program
    ["/" compositor
-    ["/." cli]]])
-
-(import: #long java/lang/String)
-
-(import: #long (java/lang/Class a)
-  (#static forName [java/lang/String] #try (java/lang/Class java/lang/Object)))
-
-(import: #long java/lang/Object
-  (toString [] java/lang/String)
-  (getClass [] (java/lang/Class java/lang/Object)))
-
-(import: #long java/lang/Long
-  (intValue [] java/lang/Integer))
-
-(import: #long java/lang/Integer
-  (longValue [] long))
-
-(import: #long java/lang/Number
-  (intValue [] java/lang/Integer)
-  (longValue [] long)
-  (doubleValue [] double))
-
-(import: #long org/armedbear/lisp/LispObject
-  (length [] int)
-  (NTH [int] org/armedbear/lisp/LispObject)
-  (SVREF [int] org/armedbear/lisp/LispObject)
-  (elt [int] org/armedbear/lisp/LispObject)
-  (execute [org/armedbear/lisp/LispObject org/armedbear/lisp/LispObject] #try org/armedbear/lisp/LispObject))
+    ["#." cli]
+    ["#." static]]])
+
+(ffi.import: java/lang/String)
+
+(ffi.import: (java/lang/Class a)
+  ["#::."
+   (#static forName [java/lang/String] #try (java/lang/Class java/lang/Object))])
+
+(ffi.import: java/lang/Object
+  ["#::."
+   (toString [] java/lang/String)
+   (getClass [] (java/lang/Class java/lang/Object))])
+
+(ffi.import: java/lang/Long
+  ["#::."
+   (intValue [] java/lang/Integer)])
+
+(ffi.import: java/lang/Integer
+  ["#::."
+   (longValue [] long)])
+
+(ffi.import: java/lang/Number
+  ["#::."
+   (intValue [] java/lang/Integer)
+   (longValue [] long)
+   (doubleValue [] double)])
+
+(ffi.import: org/armedbear/lisp/LispObject
+  ["#::."
+   (length [] int)
+   (NTH [int] org/armedbear/lisp/LispObject)
+   (SVREF [int] org/armedbear/lisp/LispObject)
+   (elt [int] org/armedbear/lisp/LispObject)
+   (execute [org/armedbear/lisp/LispObject org/armedbear/lisp/LispObject] #try org/armedbear/lisp/LispObject)])
 
 ## The org/armedbear/lisp/Interpreter must be imported before the
 ## other ones, because there is an order dependency in their static initialization.
-(import: #long org/armedbear/lisp/Interpreter
-  (#static getInstance [] org/armedbear/lisp/Interpreter)
-  (#static createInstance [] #? org/armedbear/lisp/Interpreter)
-  (eval [java/lang/String] #try org/armedbear/lisp/LispObject))
+(ffi.import: org/armedbear/lisp/Interpreter
+  ["#::."
+   (#static getInstance [] org/armedbear/lisp/Interpreter)
+   (#static createInstance [] #? org/armedbear/lisp/Interpreter)
+   (eval [java/lang/String] #try org/armedbear/lisp/LispObject)])
 
-(import: #long org/armedbear/lisp/Symbol
-  (#static T org/armedbear/lisp/Symbol))
+(ffi.import: org/armedbear/lisp/Symbol
+  ["#::."
+   (#static T org/armedbear/lisp/Symbol)])
 
-(import: #long org/armedbear/lisp/DoubleFloat
-  (new [double])
-  (doubleValue [] double))
+(ffi.import: org/armedbear/lisp/DoubleFloat
+  ["#::."
+   (new [double])
+   (doubleValue [] double)])
 
-(import: #long org/armedbear/lisp/SimpleString
-  (new [java/lang/String])
-  (getStringValue [] java/lang/String))
+(ffi.import: org/armedbear/lisp/SimpleString
+  ["#::."
+   (new [java/lang/String])
+   (getStringValue [] java/lang/String)])
 
-(import: #long org/armedbear/lisp/LispInteger)
+(ffi.import: org/armedbear/lisp/LispInteger)
 
-(import: #long org/armedbear/lisp/Bignum
-  (longValue [] long)
-  (#static getInstance [long] org/armedbear/lisp/LispInteger))
+(ffi.import: org/armedbear/lisp/Bignum
+  ["#::."
+   (longValue [] long)
+   (#static getInstance [long] org/armedbear/lisp/LispInteger)])
 
-(import: #long org/armedbear/lisp/Fixnum
-  (longValue [] long)
-  (#static getInstance [int] org/armedbear/lisp/Fixnum))
+(ffi.import: org/armedbear/lisp/Fixnum
+  ["#::."
+   (longValue [] long)
+   (#static getInstance [int] org/armedbear/lisp/Fixnum)])
 
-(import: #long org/armedbear/lisp/Nil
-  (#static NIL org/armedbear/lisp/Symbol))
+(ffi.import: org/armedbear/lisp/Nil
+  ["#::."
+   (#static NIL org/armedbear/lisp/Symbol)])
 
-(import: #long org/armedbear/lisp/SimpleVector)
+(ffi.import: org/armedbear/lisp/SimpleVector)
 
-(import: #long org/armedbear/lisp/Cons)
+(ffi.import: org/armedbear/lisp/Cons)
 
-(import: #long org/armedbear/lisp/Closure)
+(ffi.import: org/armedbear/lisp/Closure)
 
-(interface: LuxADT
+(ffi.interface: LuxADT
   (getValue [] java/lang/Object))
 
-(import: #long program/LuxADT
-  (getValue [] java/lang/Object))
+(ffi.import: program/LuxADT
+  ["#::."
+   (getValue [] java/lang/Object)])
 
 (template [<name>]
   [(exception: (<name> {object java/lang/Object})
@@ -118,44 +153,44 @@
       ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))]
       ["Object" (java/lang/Object::toString object)]))]
 
-  [unknown-kind-of-object]
-  [cannot-apply-a-non-function]
+  [unknown_kind_of_object]
+  [cannot_apply_a_non_function]
   )
 
-(def: host-bit
+(def: host_bit
   (-> Bit org/armedbear/lisp/LispObject)
   (|>> (case> #0 (org/armedbear/lisp/Nil::NIL)
               #1 (org/armedbear/lisp/Symbol::T))))
 
-(def: (host-value value)
+(def: (host_value value)
   (-> Any org/armedbear/lisp/LispObject)
-  (let [to-sub (: (-> Any org/armedbear/lisp/LispObject)
-                  (function (_ sub-value)
-                    (let [sub-value (:coerce java/lang/Object sub-value)]
+  (let [to_sub (: (-> Any org/armedbear/lisp/LispObject)
+                  (function (_ sub_value)
+                    (let [sub_value (:coerce java/lang/Object sub_value)]
                       (`` (<| (~~ (template [<type> <then>]
-                                    [(case (host.check <type> sub-value)
-                                       (#.Some sub-value)
-                                       (`` (|> sub-value (~~ (template.splice <then>))))
+                                    [(case (ffi.check <type> sub_value)
+                                       (#.Some sub_value)
+                                       (`` (|> sub_value (~~ (template.splice <then>))))
                                        #.None)]
 
-                                    [[java/lang/Object] [host-value]]
-                                    [java/lang/Boolean [..host-bit]]
+                                    [[java/lang/Object] [host_value]]
+                                    [java/lang/Boolean [..host_bit]]
                                     [java/lang/Integer [java/lang/Integer::longValue org/armedbear/lisp/Fixnum::getInstance]]
                                     [java/lang/Long [org/armedbear/lisp/Bignum::getInstance]]
                                     [java/lang/Double [org/armedbear/lisp/DoubleFloat::new]]
                                     [java/lang/String [org/armedbear/lisp/SimpleString::new]]
                                     ))
                               ## else
-                              (:coerce org/armedbear/lisp/LispObject sub-value))))))]
-    (`` (object [] org/armedbear/lisp/LispObject [program/LuxADT]
+                              (:coerce org/armedbear/lisp/LispObject sub_value))))))]
+    (`` (ffi.object [] org/armedbear/lisp/LispObject [program/LuxADT]
           []
           ## Methods
           (program/LuxADT
-           (getValue) java/lang/Object
+           [] (getValue self) java/lang/Object
            (:coerce java/lang/Object value))
 
           (org/armedbear/lisp/LispObject
-           (length)
+           [] (length self)
            int
            (|> value
                (:coerce (Array java/lang/Object))
@@ -165,12 +200,12 @@
 
           (~~ (template [<name>]
                 [(org/armedbear/lisp/LispObject
-                  (<name> {idx int})
+                  [] (<name> self {idx int})
                   org/armedbear/lisp/LispObject
                   (case (array.read (|> idx java/lang/Integer::longValue (:coerce Nat))
                                     (:coerce (Array java/lang/Object) value))
                     (#.Some sub)
-                    (to-sub sub)
+                    (to_sub sub)
 
                     #.None
                     (org/armedbear/lisp/Nil::NIL)))]
@@ -180,128 +215,135 @@
           ))))
 
 (type: (Reader a)
-  (-> a (Error Any)))
+  (-> a (Try Any)))
 
-(def: (read-variant read host-object)
+(def: (read_variant read host_object)
   (-> (Reader org/armedbear/lisp/LispObject) (Reader org/armedbear/lisp/Cons))
-  (do error.monad
-    [tag (read (org/armedbear/lisp/LispObject::NTH +0 host-object))
-     value (read (org/armedbear/lisp/LispObject::NTH +2 host-object))]
+  (do try.monad
+    [tag (read (org/armedbear/lisp/LispObject::NTH +0 host_object))
+     value (read (org/armedbear/lisp/LispObject::NTH +2 host_object))]
     (wrap [(java/lang/Long::intValue (:coerce java/lang/Long tag))
-           (case (host.check org/armedbear/lisp/Nil (org/armedbear/lisp/LispObject::NTH +1 host-object))
+           (case (ffi.check org/armedbear/lisp/Nil (org/armedbear/lisp/LispObject::NTH +1 host_object))
              (#.Some _)
-             (: Any (host.null))
+             (: Any (ffi.null))
 
              _
              (: Any synthesis.unit))
            value])))
 
-(def: (read-tuple read host-object)
+(def: (read_tuple read host_object)
   (-> (Reader org/armedbear/lisp/LispObject) (Reader org/armedbear/lisp/SimpleVector))
-  (let [size (.nat (org/armedbear/lisp/LispObject::length host-object))]
+  (let [size (.nat (org/armedbear/lisp/LispObject::length host_object))]
     (loop [idx 0
            output (:coerce (Array Any) (array.new size))]
-      (if (n/< size idx)
+      (if (n.< size idx)
         ## TODO: Start using "SVREF" instead of "elt" ASAP
-        (case (read (org/armedbear/lisp/LispObject::elt (.int idx) host-object))
-          (#error.Failure error)
-          (#error.Failure error)
+        (case (read (org/armedbear/lisp/LispObject::elt (.int idx) host_object))
+          (#try.Failure error)
+          (#try.Failure error)
 
-          (#error.Success member)
-          (recur (inc idx) (array.write idx (:coerce Any member) output)))
-        (#error.Success output)))))
+          (#try.Success member)
+          (recur (inc idx) (array.write! idx (:coerce Any member) output)))
+        (#try.Success output)))))
 
-(def: (read host-object)
+(def: (read host_object)
   (Reader org/armedbear/lisp/LispObject)
-  (`` (<| (~~ (template [<class> <post-processing>]
-                [(case (host.check <class> host-object)
-                   (#.Some host-object)
-                   (`` (|> host-object (~~ (template.splice <post-processing>))))
+  (`` (<| (~~ (template [<class> <post_processing>]
+                [(case (ffi.check <class> host_object)
+                   (#.Some host_object)
+                   (`` (|> host_object (~~ (template.splice <post_processing>))))
 
                    #.None)]
 
-                [org/armedbear/lisp/Bignum [org/armedbear/lisp/Bignum::longValue #error.Success]]
-                [org/armedbear/lisp/Fixnum [org/armedbear/lisp/Fixnum::longValue #error.Success]]
-                [org/armedbear/lisp/DoubleFloat [org/armedbear/lisp/DoubleFloat::doubleValue #error.Success]]
-                [org/armedbear/lisp/SimpleString [org/armedbear/lisp/SimpleString::getStringValue #error.Success]]
-                [org/armedbear/lisp/Cons [(read-variant read)]]
-                [org/armedbear/lisp/SimpleVector [(read-tuple read)]]
-                [org/armedbear/lisp/Nil [(new> (#error.Success false) [])]]
-                [org/armedbear/lisp/Closure [#error.Success]]
-                [program/LuxADT [program/LuxADT::getValue #error.Success]]))
-          (case (host.check org/armedbear/lisp/Symbol host-object)
-            (#.Some host-object)
-            (if (is? (org/armedbear/lisp/Symbol::T) host-object)
-              (#error.Success true)
-              (exception.throw unknown-kind-of-object (:coerce java/lang/Object host-object)))
+                [org/armedbear/lisp/Bignum [org/armedbear/lisp/Bignum::longValue #try.Success]]
+                [org/armedbear/lisp/Fixnum [org/armedbear/lisp/Fixnum::longValue #try.Success]]
+                [org/armedbear/lisp/DoubleFloat [org/armedbear/lisp/DoubleFloat::doubleValue #try.Success]]
+                [org/armedbear/lisp/SimpleString [org/armedbear/lisp/SimpleString::getStringValue #try.Success]]
+                [org/armedbear/lisp/Cons [(read_variant read)]]
+                [org/armedbear/lisp/SimpleVector [(read_tuple read)]]
+                [org/armedbear/lisp/Nil [(new> (#try.Success false) [])]]
+                [org/armedbear/lisp/Closure [#try.Success]]
+                [program/LuxADT [program/LuxADT::getValue #try.Success]]))
+          (case (ffi.check org/armedbear/lisp/Symbol host_object)
+            (#.Some host_object)
+            (if (is? (org/armedbear/lisp/Symbol::T) host_object)
+              (#try.Success true)
+              (exception.throw ..unknown_kind_of_object (:coerce java/lang/Object host_object)))
 
             #.None)
           ## else
-          (exception.throw unknown-kind-of-object (:coerce java/lang/Object host-object))
+          (exception.throw ..unknown_kind_of_object (:coerce java/lang/Object host_object))
           )))
 
-(def: ensure-macro
+(def: ensure_macro
   (-> Macro (Maybe org/armedbear/lisp/Closure))
-  (|>> (:coerce java/lang/Object) (host.check org/armedbear/lisp/Closure)))
+  (|>> (:coerce java/lang/Object) (ffi.check org/armedbear/lisp/Closure)))
 
-(def: (call-macro inputs lux macro)
-  (-> (List Code) Lux org/armedbear/lisp/Closure (Error (Error [Lux (List Code)])))
-  (do error.monad
-    [raw-output (org/armedbear/lisp/LispObject::execute (..host-value inputs) (..host-value lux) macro)]
-    (:coerce (Error (Error [Lux (List Code)]))
-             (..read raw-output))))
+(def: (call_macro inputs lux macro)
+  (-> (List Code) Lux org/armedbear/lisp/Closure (Try (Try [Lux (List Code)])))
+  (do try.monad
+    [raw_output (org/armedbear/lisp/LispObject::execute (..host_value inputs) (..host_value lux) macro)]
+    (:coerce (Try (Try [Lux (List Code)]))
+             (..read raw_output))))
 
 (def: (expander macro inputs lux)
   Expander
-  (case (ensure-macro macro)
+  (case (ensure_macro macro)
     (#.Some macro)
-    (call-macro inputs lux 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) (_.Expression Any)))
+    (exception.throw ..cannot_apply_a_non_function (:coerce java/lang/Object macro))))
 
 (def: host
-  (IO Host)
+  (IO (Host (_.Expression Any) (_.Expression Any)))
   (io (let [_ (org/armedbear/lisp/Interpreter::createInstance)
-            interpreter (org/armedbear/lisp/Interpreter::getInstance)]
-        (: Host
+            interpreter (org/armedbear/lisp/Interpreter::getInstance)
+            run! (: (-> (_.Code Any) (Try Any))
+                    (function (_ code)
+                      (do try.monad
+                        [host_value (org/armedbear/lisp/Interpreter::eval (_.code code) interpreter)]
+                        (read host_value))))]
+        (: (Host (_.Expression Any) (_.Expression Any))
            (structure
-            (def: (evaluate! alias input)
-              (do error.monad
-                [host-value (org/armedbear/lisp/Interpreter::eval (_.code input) interpreter)]
-                (read host-value)))
+            (def: (evaluate! context code)
+              (run! code))
             
-            (def: (execute! alias input)
+            (def: (execute! input)
               (org/armedbear/lisp/Interpreter::eval (_.code input) interpreter))
             
-            (def: (define! [module name] input)
-              (let [global (format (text.replace-all .module-separator ..separator module)
-                                   ..separator (name.normalize name)
-                                   "___" (%n (text/hash name)))
+            (def: (define! context input)
+              (let [global (reference.artifact context)
                     @global (_.var global)]
-                (do error.monad
+                (do try.monad
                   [#let [definition (_.defparameter @global input)]
                    _ (org/armedbear/lisp/Interpreter::eval (_.code definition) interpreter)
-                   host-value (org/armedbear/lisp/Interpreter::eval (_.code @global) interpreter)
-                   lux-value (read host-value)]
-                  (wrap [global lux-value definition])))))))))
+                   value (run! @global)]
+                  (wrap [global value definition]))))
+
+            (def: (ingest context content)
+              (|> content (\ encoding.utf8 decode) try.assume (:coerce (_.Expression Any))))
+
+            (def: (re_learn context content)
+              (run! content))
+            
+            (def: (re_load context content)
+              (do try.monad
+                [_ (run! content)]
+                (run! (_.var (reference.artifact context)))))
+            )))))
 
 (def: platform
-  (IO (Platform IO _.Var/1 (_.Expression Any) (_.Expression Any)))
+  (IO (Platform _.Var/1 (_.Expression Any) (_.Expression Any)))
   (do io.monad
     [host ..host]
-    (wrap {#platform.&monad io.monad
-           #platform.&file-system file.system
+    (wrap {#platform.&file_system (file.async file.default)
            #platform.host host
-           #platform.phase common-lisp.generate
-           #platform.runtime runtime.generate})))
+           #platform.phase common_lisp.generate
+           #platform.runtime runtime.generate
+           #platform.write (|>> _.code (\ encoding.utf8 encode))})))
 
-(def: get-ecl-cli-inputs
+(def: get_ecl_cli_inputs
   (let [@idx (_.var "i")]
     (_.call/* (_.var "loop")
               (list (_.var "for") @idx
@@ -309,23 +351,87 @@
                     (_.var "below") (_.call/* (_.var "si:argc") (list))
                     (_.var "collect") (_.call/* (_.var "si:argv") (list @idx))))))
 
-(def: program
-  (-> (_.Expression Any) (_.Expression Any))
-  (let [raw-inputs ($_ _.progn
+(def: (program context program)
+  (Program (_.Expression Any) (_.Expression Any))
+  (let [raw_inputs ($_ _.progn
                        (_.conditional+ (list "clisp") (_.var "ext:*args*"))
                        (_.conditional+ (list "sbcl") (_.var "sb-ext:*posix-argv*"))
                        (_.conditional+ (list "clozure") (_.call/* (_.var "ccl::command-line-arguments") (list)))
                        (_.conditional+ (list "gcl") (_.var "si:*command-args*"))
-                       (_.conditional+ (list "ecl") ..get-ecl-cli-inputs)
+                       (_.conditional+ (list "ecl") ..get_ecl_cli_inputs)
                        (_.conditional+ (list "cmu") (_.var "extensions:*command-line-strings*"))
                        (_.conditional+ (list "allegro") (_.call/* (_.var "sys:command-line-arguments") (list)))
                        (_.conditional+ (list "lispworks") (_.var "sys:*line-arguments-list*"))
                        (_.list/* (list)))]
-    (|>> (_.call/2 [(runtime.lux//program-args raw-inputs) _.nil]))))
-
-(program: [{service /cli.service}]
-  (/.compiler ..expander
-              ..platform
-              extension.bundle
-              ..program
-              service))
+    (_.call/2 [(runtime.lux//program_args raw_inputs) _.nil] 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)
+            (exec
+              ("lux io log" "TODO: Extender")
+              (#try.Failure "TODO: Extender"))))
+
+      @.common_lisp
+      (def: (extender handler)
+        Extender
+        (:assume handler))})
+
+(def: (declare_success! _)
+  (-> Any (Promise Any))
+  (promise.future (\ world/program.default exit +0)))
+
+(def: (then pre post)
+  (-> (_.Expression Any) (_.Expression Any) (_.Expression Any))
+  (_.manual (format (_.code pre)
+                    text.new_line
+                    (_.code post))))
+
+(def: (scope body)
+  (-> (_.Expression Any) (_.Expression Any))
+  (let [@program (_.var "lux_program")]
+    ($_ ..then
+        (_.defun @program (_.args (list)) body)
+        (_.call/* @program (list))
+        )))
+
+(`` (program: [{service /cli.service}]
+      (let [extension ".cl"]
+        (do io.monad
+          [platform ..platform]
+          (exec (do promise.monad
+                  [_ (/.compiler {#/static.host @.common_lisp
+                                  #/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 _.Expression]
+                                 ..extender
+                                 service
+                                 [(packager.package (_.manual "")
+                                                    _.code
+                                                    ..then
+                                                    ..scope)
+                                  (format (/cli.target service)
+                                          (\ file.default separator)
+                                          "program"
+                                          extension)])]
+                  (..declare_success! []))
+            (io.io []))))))