From b7d53027deeb185fa7b4312ba7079aa566762513 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 5 Jan 2018 00:00:05 -0400
Subject: - Added "lux program" compilation.

---
 new-luxc/source/luxc/lang/extension/statement.lux  | 10 +--
 .../source/luxc/lang/translation/runtime.jvm.lux   |  2 +-
 .../source/luxc/lang/translation/statement.jvm.lux | 77 ++++++++++++++++++++--
 3 files changed, 80 insertions(+), 9 deletions(-)

(limited to 'new-luxc/source/luxc/lang')

diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux
index 7cb404b13..afabf867b 100644
--- a/new-luxc/source/luxc/lang/extension/statement.lux
+++ b/new-luxc/source/luxc/lang/extension/statement.lux
@@ -12,6 +12,7 @@
   [//]
   (luxc [lang]
         (lang [".L" host]
+              [".L" scope]
               (host ["$" jvm])
               (analysis [".A" common]
                         [".A" expression])
@@ -98,11 +99,12 @@
     (case inputsC+
       (^ (list [_ (#.Symbol ["" args])] programC))
       (do macro.Monad<Meta>
-        [[_ programA] (lang.with-scope
-                        (lang.with-type (type (IO Unit))
-                          (expressionA.analyser evalL.eval programC)))
+        [[_ programA] (<| lang.with-scope
+                          (scopeL.with-local [args (type (List Text))])
+                          (lang.with-type (type (IO Unit)))
+                          (expressionA.analyser evalL.eval programC))
          programI (expressionT.translate (expressionS.synthesize programA))
-         _ (statementT.translate-program args programI)]
+         _ (statementT.translate-program programI)]
         (wrap []))
 
       _
diff --git a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
index aa210718b..df494a904 100644
--- a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
@@ -38,7 +38,7 @@
   $.Method
   ($t.method (list $t.int $Object $Object) (#.Some $Object-Array) (list)))
 
-(def: variantI
+(def: #export variantI
   $.Inst
   ($i.INVOKESTATIC hostL.runtime-class "variant_make" variant-method false))
 
diff --git a/new-luxc/source/luxc/lang/translation/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
index a734adfed..b2e302e1b 100644
--- a/new-luxc/source/luxc/lang/translation/statement.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
@@ -17,8 +17,10 @@
                          ["$i" inst]))
               ["&." scope]
               ["&." module]
+              [".L" host]
               (translation [".T" eval]
-                           [".T" common]))))
+                           [".T" common]
+                           [".T" runtime]))))
 
 (exception: #export Invalid-Definition-Value)
 (exception: #export Cannot-Evaluate-Definition)
@@ -85,6 +87,73 @@
          #let [_ (log! (format "DEF " (%ident def-ident)))]]
         (commonT.record-artifact (format bytecode-name ".class") bytecode)))))
 
-(def: #export (translate-program program-args programI)
-  (-> Text $.Inst (Meta Unit))
-  (&.fail "\"lux program\" is unimplemented."))
+(def: #export (translate-program programI)
+  (-> $.Inst (Meta Unit))
+  (let [nilI runtimeT.noneI
+        num-inputsI (|>> ($i.ALOAD +0) $i.ARRAYLENGTH)
+        decI (|>> ($i.int 1) $i.ISUB)
+        headI (|>> $i.DUP
+                   ($i.ALOAD +0)
+                   $i.SWAP
+                   $i.AALOAD
+                   $i.SWAP
+                   $i.DUP_X2
+                   $i.POP)
+        pairI (|>> ($i.int 2)
+                   ($i.ANEWARRAY "java.lang.Object")
+                   $i.DUP_X1
+                   $i.SWAP
+                   ($i.int 0)
+                   $i.SWAP
+                   $i.AASTORE
+                   $i.DUP_X1
+                   $i.SWAP
+                   ($i.int 1)
+                   $i.SWAP
+                   $i.AASTORE)
+        consI (|>> ($i.int 1)
+                   ($i.string "")
+                   $i.DUP2_X1
+                   $i.POP2
+                   runtimeT.variantI)
+        prepare-input-listI (<| $i.with-label (function [@loop])
+                                $i.with-label (function [@end])
+                                (|>> nilI
+                                     num-inputsI
+                                     ($i.label @loop)
+                                     decI
+                                     $i.DUP
+                                     ($i.IFLT @end)
+                                     headI
+                                     pairI
+                                     consI
+                                     $i.SWAP
+                                     ($i.GOTO @loop)
+                                     ($i.label @end)
+                                     $i.POP
+                                     ($i.ASTORE +0)))
+        run-ioI (|>> ($i.CHECKCAST hostL.function-class)
+                     $i.NULL
+                     ($i.INVOKEVIRTUAL hostL.function-class runtimeT.apply-method (runtimeT.apply-signature +1) false))
+        main-type ($t.method (list ($t.array +1 ($t.class "java.lang.String" (list))))
+                             #.None
+                             (list))]
+    (do macro.Monad<Meta>
+      [current-module macro.current-module-name
+       #let [normal-name "_"
+             bytecode-name (format current-module "/" normal-name)
+             class-name (text.replace-all "/" "." bytecode-name)
+             bytecode ($d.class #$.V1_6
+                                #$.Public $.finalC
+                                bytecode-name
+                                (list) ["java.lang.Object" (list)]
+                                (list)
+                                (|>> ($d.method #$.Public $.staticM "main" main-type
+                                                (|>> prepare-input-listI
+                                                     programI
+                                                     run-ioI
+                                                     $i.POP
+                                                     $i.RETURN))))]
+       #let [_ (log! (format "PROGRAM " current-module))]
+       _ (commonT.store-class class-name bytecode)]
+      (commonT.record-artifact (format bytecode-name ".class") bytecode))))
-- 
cgit v1.2.3