- Improved the way "lux program" is analysed and compiled.

- Improved the syntax for "program:" arguments.

4 files changed, 51 insertions, 53 deletions

diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index 5a50be1fa..29c9e7588 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -138,11 +138,9 @@
               (&&lux/analyse-def analyse optimize eval! compile-def ?name ?value ?meta)))
 
           "lux program"
-          (|let [(&/$Cons [_ (&/$Symbol "" ?args)]
-                          (&/$Cons ?body
-                                   (&/$Nil))) parameters]
+          (|let [(&/$Cons ?program (&/$Nil)) parameters]
             (&/with-cursor cursor
-              (&&lux/analyse-program analyse optimize compile-program ?args ?body)))
+              (&&lux/analyse-program analyse optimize compile-program ?program)))
 
           "lux case"
           (|let [(&/$Cons ?value (&/$Cons [_ (&/$Record ?branches)] (&/$Nil))) parameters]
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj
index efbf68e54..7debbde45 100644
--- a/luxc/src/lux/analyser/lux.clj
+++ b/luxc/src/lux/analyser/lux.clj
@@ -675,8 +675,7 @@
   (|do [=type (&&/analyse-1 analyse &type/Type ?type)
         ==type (eval! =type)
         _ (&type/check exo-type ==type)
-        =value (&/with-expected-type ==type
-                 (&&/analyse-1 analyse ==type ?value))
+        =value (&&/analyse-1 analyse ==type ?value)
         _cursor &/cursor]
     (return (&/|list (&&/|meta ==type _cursor
                                (&&/$ann =value =type)
@@ -689,12 +688,10 @@
         =value (&&/analyse-1+ analyse ?value)]
     (return (&/|list (coerce ==type =value)))))
 
-(let [input-type (&/$Apply &type/Text &type/List)
-      output-type (&/$Apply &type/Top &type/IO)]
-  (defn analyse-program [analyse optimize compile-program ?args ?body]
+(let [program-type (&/$Function (&/$Apply &type/Text &type/List)
+                                (&/$Apply &type/Top &type/IO))]
+  (defn analyse-program [analyse optimize compile-program ?program]
     (|do [_ &/ensure-statement
-          =body (&/with-scope ""
-                  (&&env/with-local ?args input-type
-                    (&&/analyse-1 analyse output-type ?body)))
-          _ (compile-program (optimize =body))]
+          =program (&&/analyse-1 analyse program-type ?program)
+          _ (compile-program (optimize =program))]
       (return &/$Nil))))
diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj
index 958db64ec..32824a22d 100644
--- a/luxc/src/lux/compiler/jvm/lux.clj
+++ b/luxc/src/lux/compiler/jvm/lux.clj
@@ -378,12 +378,14 @@
             (return nil)))
         ))))
 
-(defn compile-program [compile ?body]
+(defn compile-program [compile ?program]
   (|do [module-name &/get-module-name
         ^ClassWriter *writer* &/get-writer]
     (&/with-writer (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil)
                      (.visitCode))
       (|do [^MethodVisitor main-writer &/get-writer
+            _ (compile ?program)
+            :let [_ (.visitTypeInsn main-writer Opcodes/CHECKCAST &&/function-class)]
             :let [$loop (new Label)
                   $end (new Label)
                   _ (doto main-writer
@@ -438,11 +440,9 @@
                       ;; Loop: End
                       (.visitLabel $end) ;; VI
                       (.visitInsn Opcodes/POP) ;; V
-                      (.visitVarInsn Opcodes/ASTORE (int 0)) ;;
-                      )
-                  ]
-            _ (compile ?body)
+                      )]
             :let [_ (doto main-writer
+                      (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1))
                       (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
                       (.visitInsn Opcodes/ACONST_NULL)
                       (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1)))]
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux
index 466895876..72a22a267 100644
--- a/stdlib/source/lux/cli.lux
+++ b/stdlib/source/lux/cli.lux
@@ -97,10 +97,10 @@
 (def: program-args^
   (Syntax Program-Args)
   (p.alt s.local-symbol
-         (s.form (p.some (p.either (do p.Monad<Parser>
-                                     [name s.local-symbol]
-                                     (wrap [(code.symbol ["" name]) (` any)]))
-                                   (s.tuple (p.seq s.any s.any)))))))
+         (s.tuple (p.some (p.either (do p.Monad<Parser>
+                                      [name s.local-symbol]
+                                      (wrap [(code.symbol ["" name]) (` any)]))
+                                    (s.record (p.seq s.any s.any)))))))
 
 (syntax: #export (program:
                    {args program-args^}
@@ -113,39 +113,42 @@
                    bar (do-something all-args)]
                   (wrap [])))
 
-              (program: (name)
+              (program: [name]
                 (io (log! (text/compose "Hello, " name))))
 
-              (program: ([config config^])
+              (program: [{config config^}]
                 (do Monad<IO>
                   [data (init-program config)]
                   (do-something data))))}
-  (case args
-    (#Raw args)
-    (wrap (list (` ("lux program" (~ (code.symbol ["" args]))
-                    ((~! do) (~! io.Monad<IO>)
-                     []
-                     (~ body))))))
-    
-    (#Parsed args)
-    (with-gensyms [g!args g!_ g!output g!message]
-      (wrap (list (` ("lux program" (~ g!args)
-                      (case ((: (~! (..CLI (io.IO .Top)))
-                                ((~! do) (~! p.Monad<Parser>)
-                                 [(~+ (|> args
-                                          (list/map (function (_ [binding parser])
-                                                      (list binding parser)))
-                                          list/join))
-                                  (~ g!_) ..end]
-                                 ((~' wrap) ((~! do) (~! io.Monad<IO>)
-                                             []
-                                             (~ body)))))
-                             (~ g!args))
-                        (#E.Success [(~ g!_) (~ g!output)])
-                        (~ g!output)
-
-                        (#E.Error (~ g!message))
-                        (error! (~ g!message))
-                        )))
-                  )))
-    ))
+  (with-gensyms [g!program]
+    (case args
+      (#Raw args)
+      (wrap (list (` ("lux program"
+                      (.function ((~ g!program) (~ (code.symbol ["" args])))
+                        ((~! do) (~! io.Monad<IO>)
+                         []
+                         (~ body)))))))
+      
+      (#Parsed args)
+      (with-gensyms [g!args g!_ g!output g!message]
+        (wrap (list (` ("lux program"
+                        (.function ((~ g!program) (~ g!args))
+                          (case ((: (~! (..CLI (io.IO .Top)))
+                                    ((~! do) (~! p.Monad<Parser>)
+                                     [(~+ (|> args
+                                              (list/map (function (_ [binding parser])
+                                                          (list binding parser)))
+                                              list/join))
+                                      (~ g!_) ..end]
+                                     ((~' wrap) ((~! do) (~! io.Monad<IO>)
+                                                 []
+                                                 (~ body)))))
+                                 (~ g!args))
+                            (#E.Success [(~ g!_) (~ g!output)])
+                            (~ g!output)
+
+                            (#E.Error (~ g!message))
+                            (error! (~ g!message))
+                            ))))
+                    )))
+      )))