aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
authorEduardo Julian2019-04-07 17:49:35 -0400
committerEduardo Julian2019-04-07 17:49:35 -0400
commita4e0eb58480a05e4c23a07d33965022125c539f2 (patch)
tree751b2dd5f6154b5940df39a3cb16c49868cd6551 /new-luxc
parenta61c3f2e7bc29c3224264317b14254fe93d503fe (diff)
Updated the JVM compiler to the latest changes.
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/host/jvm.lux17
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux5
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm.lux43
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux7
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux23
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux11
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux3
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux8
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux8
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux110
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux3
-rw-r--r--new-luxc/source/program.lux161
15 files changed, 206 insertions, 205 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
index 71e887d4d..da9dcb974 100644
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -1,7 +1,8 @@
(.module:
[lux (#- Type Definition)
+ [abstract
+ monad]
[control
- monad
["p" parser]]
[data
[collection
@@ -16,7 +17,7 @@
[compiler
[reference (#+ Register)]
[phase
- ["." translation]]]]])
+ ["." generation]]]]])
## [Host]
(import: org/objectweb/asm/MethodVisitor)
@@ -94,17 +95,17 @@
(type: #export Anchor [Label Register])
(type: #export Host
- (translation.Host Inst Definition))
+ (generation.Host Inst Definition))
(template [<name> <base>]
[(type: #export <name>
(<base> ..Anchor Inst Definition))]
- [State translation.State]
- [Operation translation.Operation]
- [Phase translation.Phase]
- [Handler translation.Handler]
- [Bundle translation.Bundle]
+ [State generation.State]
+ [Operation generation.Operation]
+ [Phase generation.Phase]
+ [Handler generation.Handler]
+ [Bundle generation.Bundle]
)
## [Values]
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index f9b6e5c2d..012d7ceee 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -1,5 +1,7 @@
(.module:
[lux #*
+ [control
+ ["." function]]
[data
["." text
format]
@@ -7,8 +9,7 @@
[collection
["." array (#+ Array)]
["." list ("#/." functor)]]]
- ["." host (#+ import: do-to)]
- ["." function]]
+ ["." host (#+ import: do-to)]]
["$" //
["$t" type]])
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index 36a020686..f1ae8abd2 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -1,7 +1,9 @@
(.module:
[lux (#- int char)
+ [abstract
+ [monad (#+ do)]]
[control
- [monad (#+ do)]
+ ["." function]
["p" parser]]
[data
["." maybe]
@@ -14,7 +16,6 @@
[macro
["." code]
["s" syntax (#+ syntax:)]]
- ["." function]
[tool
[compiler
[phase (#+ Operation)]]]]
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux
index d1d1a9f4c..4d2031d12 100644
--- a/new-luxc/source/luxc/lang/translation/jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm.lux
@@ -1,12 +1,15 @@
(.module:
[lux (#- Definition)
+ [abstract
+ [monad (#+ do)]]
[control
pipe
- [monad (#+ do)]
["ex" exception (#+ exception:)]
+ ["." io (#+ IO io)]
[concurrency
["." atom (#+ Atom atom)]]]
[data
+ ["." product]
["." error (#+ Error)]
["." text ("#/." hash)
format]
@@ -17,14 +20,11 @@
["." host (#+ import: do-to object)
[jvm
["." loader (#+ Library)]]]
- ["." io (#+ IO io)]
[world
[binary (#+ Binary)]]
[tool
[compiler
- ["." name]
- [phase
- ["." translation]]]]]
+ ["." name]]]]
[///
[host
["." jvm (#+ Inst Definition Host State)
@@ -85,7 +85,7 @@
(def: class-path-separator ".")
(def: (evaluate! library loader eval-class valueI)
- (-> Library ClassLoader Text Inst (Error Any))
+ (-> Library ClassLoader Text Inst (Error [Any Definition]))
(let [bytecode-name (text.replace-all class-path-separator .module-separator eval-class)
bytecode (def.class #jvm.V1_6
#jvm.Public jvm.noneC
@@ -102,23 +102,31 @@
inst.RETURN))))]
(io.run (do (error.with io.monad)
[_ (loader.store eval-class bytecode library)
- class (loader.load eval-class loader)]
- (:: io.monad wrap (class-value eval-class class))))))
+ class (loader.load eval-class loader)
+ value (:: io.monad wrap (class-value eval-class class))]
+ (wrap [value
+ [eval-class bytecode]])))))
(def: (execute! library loader temp-label [class-name class-bytecode])
(-> Library ClassLoader Text Definition (Error Any))
(io.run (do (error.with io.monad)
- [_ (loader.store class-name class-bytecode library)]
+ [existing-class? (|> (atom.read library)
+ (:: io.monad map (dictionary.contains? class-name))
+ (error.lift io.monad)
+ (: (IO (Error Bit))))
+ _ (if ?existing-class
+ (wrap [])
+ (loader.store class-name class-bytecode library))]
(loader.load class-name loader))))
(def: (define! library loader [module name] valueI)
- (-> Library ClassLoader Name Inst (Error [Text Any]))
+ (-> Library ClassLoader Name Inst (Error [Text Any Definition]))
(let [class-name (format (text.replace-all .module-separator class-path-separator module)
class-path-separator (name.normalize name)
"___" (%n (text/hash name)))]
(do error.monad
- [value (evaluate! library loader class-name valueI)]
- (wrap [class-name value]))))
+ [[value definition] (evaluate! library loader class-name valueI)]
+ (wrap [class-name value definition]))))
(def: #export host
(IO Host)
@@ -128,9 +136,14 @@
(structure
(def: (evaluate! temp-label valueI)
(let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))]
- (..evaluate! library loader eval-class valueI)))
- (def: execute! (..execute! library loader))
- (def: define! (..define! library loader)))))))
+ (:: error.monad map product.left
+ (..evaluate! library loader eval-class valueI))))
+
+ (def: execute!
+ (..execute! library loader))
+
+ (def: define!
+ (..define! library loader)))))))
(def: #export runtime-class "LuxRuntime")
(def: #export function-class "LuxFunction")
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
index 457c052a2..32b002b91 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
@@ -1,8 +1,9 @@
(.module:
[lux (#- if let case)
- ["." function]
+ [abstract
+ [monad (#+ do)]]
[control
- [monad (#+ do)]
+ ["." function]
["ex" exception (#+ exception:)]]
[data
[text
diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux
index 896fc9de3..ea6665dc5 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux
@@ -1,9 +1,10 @@
(.module:
[lux #*
+ [abstract
+ [monad (#+ do)]]
[control
- [monad (#+ do)]
- ["ex" exception (#+ exception:)]]
- ["." io]
+ ["ex" exception (#+ exception:)]
+ ["." io]]
[data
["." error (#+ Error)]
["." text ("#/." hash)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux
index 8c35952fd..db8716697 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux
@@ -1,9 +1,10 @@
(.module:
[lux (#- function)
- ["." function]
+ [abstract
+ ["." monad (#+ do)]]
[control
[pipe (#+ when> new>)]
- ["." monad (#+ do)]]
+ ["." function]]
[data
["." text
format]
@@ -15,7 +16,7 @@
[synthesis (#+ Synthesis Abstraction Apply)]
["_." reference (#+ Register Variable)]
["." phase
- ["." translation]]]]]
+ ["." generation]]]]]
[luxc
[lang
[host
@@ -295,16 +296,16 @@
(-> Phase Abstraction (Operation Inst))
(do phase.monad
[@begin _.make-label
- [function-class bodyI] (translation.with-context
- (translation.with-anchor [@begin 1]
+ [function-class bodyI] (generation.with-context
+ (generation.with-anchor [@begin 1]
(translate bodyS)))
[functionD instanceI] (with-function @begin function-class env arity bodyI)
- _ (translation.save! ["" function-class]
- [function-class
- (def.class #$.V1_6 #$.Public $.finalC
- function-class (list)
- ($.simple-class //.function-class) (list)
- functionD)])]
+ _ (generation.save! ["" function-class]
+ [function-class
+ (def.class #$.V1_6 #$.Public $.finalC
+ function-class (list)
+ ($.simple-class //.function-class) (list)
+ functionD)])]
(wrap instanceI)))
(def: (segment size elems)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux
index 6e3f01c78..d7e706aaf 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux
@@ -1,8 +1,9 @@
(.module:
[lux #*
- ["." function]
- [control
+ [abstract
["." monad (#+ do)]]
+ [control
+ ["." function]]
[data
["." text
format]
@@ -13,7 +14,7 @@
[reference (#+ Register)]
["." synthesis (#+ Synthesis)]
["." phase
- ["." translation]]]]]
+ ["." generation]]]]]
[luxc
[lang
[host
@@ -33,7 +34,7 @@
(def: #export (recur translate argsS)
(-> Phase (List Synthesis) (Operation Inst))
(do phase.monad
- [[@begin start] translation.anchor
+ [[@begin start] generation.anchor
#let [end (|> argsS list.size dec (n/+ start))
pairs (list.zip2 (list.n/range start end)
argsS)]
@@ -66,7 +67,7 @@
(do phase.monad
[@begin _.make-label
initsI+ (monad.map @ translate initsS+)
- iterationI (translation.with-anchor [@begin start]
+ iterationI (generation.with-anchor [@begin start]
(translate iterationS))
#let [initializationI (|> (list.enumerate initsI+)
(list/map (function (_ [register initI])
diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux
index e514fe28a..f9d9034ea 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux
@@ -1,6 +1,6 @@
(.module:
[lux (#- i64)
- [control
+ [abstract
monad]
[data
[text
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
index 6f5fccf4e..b19287b4e 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -1,7 +1,8 @@
(.module:
[lux #*
+ [abstract
+ ["." monad (#+ do)]]
[control
- ["." monad (#+ do)]
["p" parser]
["ex" exception (#+ exception:)]]
[data
diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux
index 0a354a929..c821a9de2 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux
@@ -1,6 +1,6 @@
(.module:
[lux #*
- [control
+ [abstract
[monad (#+ do)]]
[data
[text
@@ -10,7 +10,7 @@
["." name]
["." reference (#+ Register Variable)]
["." phase ("operation/." monad)
- ["." translation]]]]]
+ ["." generation]]]]]
[luxc
[lang
[host
@@ -31,7 +31,7 @@
(def: (foreign variable)
(-> Register (Operation Inst))
(do phase.monad
- [function-class translation.context]
+ [function-class generation.context]
(wrap (|>> (_.ALOAD 0)
(_.GETFIELD function-class
(|> variable .nat foreign-name)
@@ -53,5 +53,5 @@
(def: #export (constant name)
(-> Name (Operation Inst))
(do phase.monad
- [bytecode-name (translation.remember name)]
+ [bytecode-name (generation.remember name)]
(operation/wrap (_.GETSTATIC bytecode-name //.value-field //.$Object))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index ae984baa9..78e613076 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -1,6 +1,6 @@
(.module:
[lux #*
- [control
+ [abstract
[monad (#+ do)]]
[data
[text
@@ -13,7 +13,7 @@
[analysis (#+ Arity)]
["." synthesis]
["." phase
- ["." translation]]]]]
+ ["." generation]]]]]
[luxc
[lang
[host
@@ -311,7 +311,7 @@
pm-methods
io-methods))]
(do phase.monad
- [_ (translation.execute! //.runtime-class [//.runtime-class bytecode])]
+ [_ (generation.execute! //.runtime-class [//.runtime-class bytecode])]
(wrap bytecode))))
(def: translate-function
@@ -341,7 +341,7 @@
_.RETURN))
applyI))]
(do phase.monad
- [_ (translation.execute! //.function-class [//.function-class bytecode])]
+ [_ (generation.execute! //.function-class [//.function-class bytecode])]
(wrap bytecode))))
(def: #export translate
diff --git a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux
deleted file mode 100644
index 65ab9d147..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux
+++ /dev/null
@@ -1,110 +0,0 @@
-(.module:
- lux
- (lux (control monad
- ["ex" exception #+ exception:])
- (data ["e" error]
- [maybe]
- [text "text/" Monoid<Text> Hash<Text>]
- text/format
- (coll [list "list/" Functor<List> Fold<List>]))
- [macro])
- (luxc ["&" lang]
- ["&." io]
- (lang (host ["$" jvm]
- (jvm ["$t" type]
- ["$d" def]
- ["$i" inst]))
- ["&." scope]
- ["&." module]
- [".L" host]))
- (// [".T" common]
- [".T" runtime]))
-
-## (def: (lux//program procedure)
-## (-> Text //.Statement)
-## (function (_ inputsC+)
-## (case inputsC+
-## (^ (list [_ (#.Identifier ["" args])] programC))
-## (do macro.Monad<Meta>
-## [[_ programA] (<| lang.with-scope
-## (scopeL.with-local [args (type (List Text))])
-## (lang.with-type (type (IO Any)))
-## (expressionA.analyser evalL.eval programC))
-## syntheses //.all-syntheses
-## programI (expressionT.translate (expressionS.synthesize syntheses programA))
-## _ (statementT.translate-program programI)]
-## (wrap []))
-
-## _
-## (throw-invalid-statement procedure inputsC+))))
-
-(def: #export (translate-program programI)
- (-> $.Inst (Meta Any))
- (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) #0))
- 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))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux
index 7bf54b7ea..527228c8e 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux
@@ -1,7 +1,8 @@
(.module:
[lux #*
+ [abstract
+ ["." monad (#+ do)]]
[control
- ["." monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
[text
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index c669b9c24..23384cf17 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -1,59 +1,148 @@
(.module:
[lux #*
- [cli (#+ program:)]
- [control
+ ["." host (#+ import:)]
+ [abstract
[monad (#+ do)]]
- ["." io (#+ IO)]
+ [control
+ [cli (#+ program:)]
+ ["." io (#+ IO)]]
+ [data
+ ["." error (#+ Error)]
+ [collection
+ [array (#+ Array)]]]
[world
["." file]]
- [host
- ["." js]]
[tool
[compiler
- ["." cli]
- ["/" program]
[phase
- ["." macro]
- ["." translation
- [".T" js
- [".JS" runtime]
- [".JS" expression]
- [".JS" extension]]]
- ["." statement]]
+ ["." macro (#+ Expander)]]
[default
["." platform (#+ Platform)]]]]]
+ [program
+ ["/" compositor
+ ["/." cli]]]
[luxc
[lang
[host
- ["." jvm]]
+ ["_" jvm
+ ["$t" type]
+ ["$d" def]
+ ["$i" inst]]]
[translation
- [".T" jvm
- [".JVM" runtime]
- [".JVM" expression]
+ ["." jvm
+ ["." runtime]
+ ["." expression]
[procedure
- [".JVM" common]]]]]]
- )
+ ["." common]]]]]])
+
+(import: #long java/lang/reflect/Method
+ (invoke [java/lang/Object (Array java/lang/Object)] #try java/lang/Object))
+
+(import: #long (java/lang/Class c)
+ (getMethod [java/lang/String (Array (java/lang/Class java/lang/Object))] #try java/lang/reflect/Method))
+
+(import: #long java/lang/Object
+ (getClass [] (java/lang/Class java/lang/Object)))
+
+(def: _object-class
+ (java/lang/Class java/lang/Object)
+ (host.class-for java/lang/Object))
+
+(def: _apply-args
+ (Array (java/lang/Class java/lang/Object))
+ (|> (host.array (java/lang/Class java/lang/Object) 2)
+ (host.array-write 0 _object-class)
+ (host.array-write 1 _object-class)))
+
+(def: (expander macro inputs lux)
+ Expander
+ (do error.monad
+ [apply-method (|> macro
+ (:coerce java/lang/Object)
+ (java/lang/Object::getClass)
+ (java/lang/Class::getMethod "apply" _apply-args))]
+ (:coerce (Error (Error [Lux (List Code)]))
+ (java/lang/reflect/Method::invoke
+ (:coerce java/lang/Object macro)
+ (|> (host.array java/lang/Object 2)
+ (host.array-write 0 (:coerce java/lang/Object inputs))
+ (host.array-write 1 (:coerce java/lang/Object lux)))
+ apply-method))))
(def: jvm
- (IO (Platform IO jvm.Anchor jvm.Inst jvm.Definition))
+ (IO (Platform IO _.Anchor _.Inst _.Definition))
(do io.monad
- [host jvmT.host]
+ [host jvm.host]
(wrap {#platform.&monad io.monad
#platform.&file-system file.system
#platform.host host
- #platform.phase expressionJVM.translate
- #platform.runtime runtimeJVM.translate})))
+ #platform.phase expression.translate
+ #platform.runtime runtime.translate})))
-(def: js
- (IO (Platform IO js.Var js.Expression js.Statement))
- (do io.monad
- [host jsT.host]
- (wrap {#platform.&monad io.monad
- #platform.&file-system file.system
- #platform.host host
- #platform.phase expressionJS.translate
- #platform.runtime runtimeJS.translate})))
+(def: (program programI)
+ (-> _.Inst _.Definition)
+ (let [nilI runtime.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
+ runtime.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 jvm.function-class)
+ $i.NULL
+ ($i.INVOKEVIRTUAL jvm.function-class runtime.apply-method (runtime.apply-signature 1) #0))
+ main-type ($t.method (list ($t.array 1 ($t.class "java.lang.String" (list))))
+ #.None
+ (list))
+ bytecode-name "_"]
+ [bytecode-name
+ ($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))))]))
-(program: [{service cli.service}]
- ## (/.compiler macro.jvm ..jvm commonJVM.bundle service)
- (/.compiler jsT.expander ..js extensionJS.bundle service))
+(program: [{service /cli.service}]
+ (/.compiler ..expander ..jvm common.bundle ..program service))