aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/extension/statement.lux10
-rw-r--r--new-luxc/source/luxc/lang/translation/runtime.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/statement.jvm.lux77
3 files changed, 80 insertions, 9 deletions
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))))