aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm.lux22
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux58
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/function.lux60
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/runtime.lux27
-rw-r--r--lux-jvm/source/program.lux1
5 files changed, 91 insertions, 77 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux
index cebd5e652..0ffea0e42 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm.lux
@@ -104,9 +104,10 @@
..class-path-separator (%.nat module-id)
..class-path-separator (%.nat artifact-id)))
-(def: (evaluate! library loader eval-class valueI)
- (-> Library java/lang/ClassLoader Text Inst (Try [Any Definition]))
- (let [bytecode-name (..bytecode-name eval-class)
+(def: (evaluate! library loader context valueI)
+ (-> Library java/lang/ClassLoader generation.Context Inst (Try [Any Definition]))
+ (let [eval-class (..class-name context)
+ bytecode-name (..bytecode-name eval-class)
bytecode (def.class #jvm.V1_6
#jvm.Public jvm.noneC
bytecode-name
@@ -127,8 +128,8 @@
(wrap [value
[eval-class bytecode]])))))
-(def: (execute! library loader temp-label [class-name class-bytecode])
- (-> Library java/lang/ClassLoader Text Definition (Try Any))
+(def: (execute! library loader [class-name class-bytecode])
+ (-> Library java/lang/ClassLoader Definition (Try Any))
(io.run (do (try.with io.monad)
[existing-class? (|> (atom.read library)
(:: io.monad map (dictionary.contains? class-name))
@@ -141,10 +142,9 @@
(def: (define! library loader context valueI)
(-> Library java/lang/ClassLoader generation.Context Inst (Try [Text Any Definition]))
- (let [class-name (..class-name context)]
- (do try.monad
- [[value definition] (evaluate! library loader class-name valueI)]
- (wrap [class-name value definition]))))
+ (do try.monad
+ [[value definition] (evaluate! library loader context valueI)]
+ (wrap [(..class-name context) value definition])))
(def: #export host
(IO Host)
@@ -152,9 +152,9 @@
loader (loader.memory library)]
(: Host
(structure
- (def: (evaluate! temp-label valueI)
+ (def: (evaluate! context valueI)
(:: try.monad map product.left
- (..evaluate! library loader (text.replace-all " " "$" temp-label) valueI)))
+ (..evaluate! library loader context valueI)))
(def: execute!
(..execute! library loader))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
index 31846598e..5796cc8b9 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
@@ -792,7 +792,7 @@
(<s>.tuple (<>.and <s>.text ..value)))
(def: overriden-method-definition
- (Parser [Environment (/.Overriden-Method Synthesis)])
+ (Parser [(Environment Synthesis) (/.Overriden-Method Synthesis)])
(<s>.tuple (do <>.monad
[_ (<s>.text! /.overriden-tag)
ownerT ..class
@@ -849,7 +849,7 @@
)))
(def: (normalize-method-body mapping)
- (-> (Dictionary Variable Variable) Synthesis Synthesis)
+ (-> (Dictionary Synthesis Variable) Synthesis Synthesis)
(function (recur body)
(case body
(^template [<tag>]
@@ -866,7 +866,7 @@
(^ (synthesis.variable var))
(|> mapping
- (dictionary.get var)
+ (dictionary.get body)
(maybe.default var)
synthesis.variable)
@@ -889,10 +889,17 @@
(synthesis.loop/recur (list@map recur updatesS+))
(^ (synthesis.function/abstraction [environment arity bodyS]))
- (synthesis.function/abstraction [(|> environment (list@map (function (_ local)
- (|> mapping
- (dictionary.get local)
- (maybe.default local)))))
+ (synthesis.function/abstraction [(list@map (function (_ captured)
+ (case captured
+ (^ (synthesis.variable var))
+ (|> mapping
+ (dictionary.get captured)
+ (maybe.default var)
+ synthesis.variable)
+
+ _
+ captured))
+ environment)
arity
bodyS])
@@ -905,13 +912,13 @@
(def: $Object (type.class "java.lang.Object" (list)))
(def: (anonymous-init-method env)
- (-> Environment (Type Method))
+ (-> (Environment Synthesis) (Type Method))
(type.method [(list.repeat (list.size env) $Object)
type.void
(list)]))
(def: (with-anonymous-init class env super-class inputsTI)
- (-> (Type Class) Environment (Type Class) (List (Typed Inst)) Def)
+ (-> (Type Class) (Environment Synthesis) (Type Class) (List (Typed Inst)) Def)
(let [store-capturedI (|> env
list.size
list.indices
@@ -927,10 +934,10 @@
store-capturedI
_.RETURN))))
-(def: (anonymous-instance archive class env)
- (-> Archive (Type Class) Environment (Operation Inst))
+(def: (anonymous-instance generate archive class env)
+ (-> Phase Archive (Type Class) (Environment Synthesis) (Operation Inst))
(do {@ phase.monad}
- [captureI+ (monad.map @ (///reference.variable archive) env)]
+ [captureI+ (monad.map @ (generate archive) env)]
(wrap (|>> (_.NEW class)
_.DUP
(_.fuse captureI+)
@@ -987,14 +994,14 @@
## Combine them.
list@join
## Remove duplicates.
- (set.from-list variable.hash)
+ (set.from-list synthesis.hash)
set.to-list)
global-mapping (|> total-environment
## Give them names as "foreign" variables.
list.enumerate
(list@map (function (_ [id capture])
[capture (#variable.Foreign id)]))
- (dictionary.from-list variable.hash))
+ (dictionary.from-list synthesis.hash))
normalized-methods (list@map (function (_ [environment
[ownerT name
strict-fp? annotations vars
@@ -1003,11 +1010,11 @@
(let [local-mapping (|> environment
list.enumerate
(list@map (function (_ [foreign-id capture])
- [(#variable.Foreign foreign-id)
+ [(synthesis.variable/foreign foreign-id)
(|> global-mapping
(dictionary.get capture)
maybe.assume)]))
- (dictionary.from-list variable.hash))]
+ (dictionary.from-list synthesis.hash))]
[ownerT name
strict-fp? annotations vars
self-name arguments returnT exceptionsT
@@ -1032,15 +1039,16 @@
exceptionsT])
(|>> bodyG (returnI returnT)))))))
(:: @ map _def.fuse))
- _ (generation.save! true ["" (%.nat artifact-id)]
- [anonymous-class-name
- (_def.class #$.V1_6 #$.Public $.finalC
- anonymous-class-name (list)
- super-class super-interfaces
- (|>> (///function.with-environment total-environment)
- (..with-anonymous-init class total-environment super-class inputsTI)
- method-definitions))])]
- (anonymous-instance archive class total-environment)))]))
+ #let [directive [anonymous-class-name
+ (_def.class #$.V1_6 #$.Public $.finalC
+ anonymous-class-name (list)
+ super-class super-interfaces
+ (|>> (///function.with-environment total-environment)
+ (..with-anonymous-init class total-environment super-class inputsTI)
+ method-definitions))]]
+ _ (generation.execute! directive)
+ _ (generation.save! (%.nat artifact-id) directive)]
+ (..anonymous-instance generate archive class total-environment)))]))
(def: bundle::class
Bundle
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
index bfa11f1c2..2a792612c 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
@@ -1,7 +1,8 @@
(.module:
[lux (#- Type function)
[abstract
- ["." monad (#+ do)]]
+ ["." monad (#+ do)]
+ ["." enum]]
[control
[pipe (#+ when> new>)]
["." function]]
@@ -48,11 +49,11 @@
(n.> 1 arity))
(def: (captured-args env)
- (-> Environment (List (Type Value)))
+ (-> (Environment Synthesis) (List (Type Value)))
(list.repeat (list.size env) //.$Value))
(def: (init-method env arity)
- (-> Environment Arity (Type Method))
+ (-> (Environment Synthesis) Arity (Type Method))
(if (poly-arg? arity)
(type.method [(list.concat (list (captured-args env)
(list type.int)
@@ -76,7 +77,7 @@
(def: (inputsI start amount)
(-> Register Nat Inst)
- (|> (list.n/range start (n.+ start (dec amount)))
+ (|> (enum.range n.enum start (n.+ start (dec amount)))
(list@map _.ALOAD)
_.fuse))
@@ -102,10 +103,10 @@
(list.repeat amount)
_.fuse))
-(def: (instance archive class arity env)
- (-> Archive (Type Class) Arity Environment (Operation Inst))
+(def: (instance generate archive class arity env)
+ (-> Phase Archive (Type Class) Arity (Environment Synthesis) (Operation Inst))
(do {@ phase.monad}
- [captureI+ (monad.map @ (reference.variable archive) env)
+ [captureI+ (monad.map @ (generate archive) env)
#let [argsI (if (poly-arg? arity)
(|> (nullsI (dec arity))
(list (_.int +0))
@@ -122,13 +123,13 @@
(type.method [(list) return (list)]))
(def: (with-reset class arity env)
- (-> (Type Class) Arity Environment Def)
+ (-> (Type Class) Arity (Environment Synthesis) Def)
(def.method #$.Public $.noneM "reset" (reset-method class)
(if (poly-arg? arity)
(let [env-size (list.size env)
captureI (|> (case env-size
0 (list)
- _ (list.n/range 0 (dec env-size)))
+ _ (enum.range n.enum 0 (dec env-size)))
(list@map (.function (_ source)
(|>> (_.ALOAD 0)
(_.GETFIELD class (reference.foreign-name source) //.$Value))))
@@ -164,20 +165,20 @@
(_.INVOKESPECIAL //.$Function "<init>" function-init-method))))
(def: (with-init class env arity)
- (-> (Type Class) Environment Arity Def)
+ (-> (Type Class) (Environment Synthesis) Arity Def)
(let [env-size (list.size env)
offset-partial (: (-> Nat Nat)
(|>> inc (n.+ env-size)))
store-capturedI (|> (case env-size
0 (list)
- _ (list.n/range 0 (dec env-size)))
+ _ (enum.range n.enum 0 (dec env-size)))
(list@map (.function (_ register)
(|>> (_.ALOAD 0)
(_.ALOAD (inc register))
(_.PUTFIELD class (reference.foreign-name register) //.$Value))))
_.fuse)
store-partialI (if (poly-arg? arity)
- (|> (list.n/range 0 (n.- 2 arity))
+ (|> (enum.range n.enum 0 (n.- 2 arity))
(list@map (.function (_ idx)
(let [register (offset-partial idx)]
(|>> (_.ALOAD 0)
@@ -193,17 +194,17 @@
_.RETURN))))
(def: (with-apply class env function-arity @begin bodyI apply-arity)
- (-> (Type Class) Environment Arity Label Inst Arity
+ (-> (Type Class) (Environment Synthesis) Arity Label Inst Arity
Def)
(let [num-partials (dec function-arity)
@default ($.new-label [])
@labels (list@map $.new-label (list.repeat num-partials []))
over-extent (|> (.int function-arity) (i.- (.int apply-arity)))
casesI (|> (list@compose @labels (list @default))
- (list.zip2 (list.n/range 0 num-partials))
+ (list.zip2 (enum.range n.enum 0 num-partials))
(list@map (.function (_ [stage @label])
(let [load-partialsI (if (n.> 0 stage)
- (|> (list.n/range 0 (dec stage))
+ (|> (enum.range n.enum 0 (dec stage))
(list@map (|>> reference.partial-name (load-fieldI class)))
_.fuse)
function.identity)]
@@ -233,7 +234,7 @@
(let [env-size (list.size env)
load-capturedI (|> (case env-size
0 (list)
- _ (list.n/range 0 (dec env-size)))
+ _ (enum.range n.enum 0 (dec env-size)))
(list@map (|>> reference.foreign-name (load-fieldI class)))
_.fuse)]
(|>> (_.label @label)
@@ -257,7 +258,7 @@
))))
(def: #export with-environment
- (-> Environment Def)
+ (-> (Environment Synthesis) Def)
(|>> list.enumerate
(list@map (.function (_ [env-idx env-source])
(def.field #$.Private $.finalF (reference.foreign-name env-idx) //.$Value)))
@@ -266,20 +267,20 @@
(def: (with-partial arity)
(-> Arity Def)
(if (poly-arg? arity)
- (|> (list.n/range 0 (n.- 2 arity))
+ (|> (enum.range n.enum 0 (n.- 2 arity))
(list@map (.function (_ idx)
(def.field #$.Private $.finalF (reference.partial-name idx) //.$Value)))
def.fuse)
function.identity))
-(def: #export (with-function archive @begin class env arity bodyI)
- (-> Archive Label Text Environment Arity Inst
+(def: #export (with-function generate archive @begin class env arity bodyI)
+ (-> Phase Archive Label Text (Environment Synthesis) Arity Inst
(Operation [Def Inst]))
(let [classD (type.class class (list))
applyD (: Def
(if (poly-arg? arity)
(|> (n.min arity //runtime.num-apply-variants)
- (list.n/range 1)
+ (enum.range n.enum 1)
(list@map (with-apply classD env arity @begin bodyI))
(list& (with-implementation arity @begin bodyI))
def.fuse)
@@ -296,7 +297,7 @@
applyD
))]
(do phase.monad
- [instanceI (instance archive classD arity env)]
+ [instanceI (..instance generate archive classD arity env)]
(wrap [functionD instanceI]))))
(def: #export (function generate archive [env arity bodyS])
@@ -307,13 +308,14 @@
(generation.with-anchor [@begin 1]
(generate archive bodyS)))
#let [function-class (//.class-name function-context)]
- [functionD instanceI] (with-function archive @begin function-class env arity bodyI)
- _ (generation.save! true ["" (%.nat (product.right function-context))]
- [function-class
- (def.class #$.V1_6 #$.Public $.finalC
- function-class (list)
- //.$Function (list)
- functionD)])]
+ [functionD instanceI] (..with-function generate archive @begin function-class env arity bodyI)
+ #let [directive [function-class
+ (def.class #$.V1_6 #$.Public $.finalC
+ function-class (list)
+ //.$Function (list)
+ functionD)]]
+ _ (generation.execute! directive)
+ _ (generation.save! (%.nat (product.right function-context)) directive)]
(wrap instanceI)))
(def: #export (call generate archive [functionS argsS])
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
index 1cad5569f..e7a37584e 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
@@ -1,7 +1,8 @@
(.module:
[lux (#- Type)
[abstract
- [monad (#+ do)]]
+ [monad (#+ do)]
+ ["." enum]]
[data
[binary (#+ Binary)]
["." product]
@@ -9,7 +10,9 @@
["%" format (#+ format)]]
[collection
["." list ("#@." functor)]
- ["." row]]]
+ ["." row]]
+ [number
+ ["n" nat]]]
["." math]
[target
[jvm
@@ -339,18 +342,18 @@
frac-methods
pm-methods
io-methods))
- payload ["0" bytecode]]
+ directive [runtime-class bytecode]]
(do phase.monad
- [_ (generation.execute! runtime-class [runtime-class bytecode])
- _ (generation.save! false ["" "0"] payload)]
- (wrap payload))))
+ [_ (generation.execute! directive)
+ _ (generation.save! "0" directive)]
+ (wrap ["0" bytecode]))))
(def: translate-function
(Operation [Text Binary])
- (let [applyI (|> (list.n/range 2 num-apply-variants)
+ (let [applyI (|> (enum.range n.enum 2 num-apply-variants)
(list@map (function (_ arity)
($d.method #$.Public $.noneM apply-method (apply-signature arity)
- (let [preI (|> (list.n/range 0 (dec arity))
+ (let [preI (|> (enum.range n.enum 0 (dec arity))
(list@map _.ALOAD)
_.fuse)]
(|>> preI
@@ -373,11 +376,11 @@
(_.PUTFIELD //.$Function partials-field type.int)
_.RETURN))
applyI))
- payload ["1" bytecode]]
+ directive [function-class bytecode]]
(do phase.monad
- [_ (generation.execute! function-class [function-class bytecode])
- _ (generation.save! false ["" "1"] payload)]
- (wrap payload))))
+ [_ (generation.execute! directive)
+ _ (generation.save! "1" directive)]
+ (wrap ["1" bytecode]))))
(def: #export translate
(Operation [Registry Output])
diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux
index 2dcbd5471..1114dd3b6 100644
--- a/lux-jvm/source/program.lux
+++ b/lux-jvm/source/program.lux
@@ -168,6 +168,7 @@
translation.bundle
(directive.bundle ..extender)
(jvm/program.program jvm/runtime.class-name)
+ [_.Anchor _.Inst _.Definition]
..extender
service
[packager.package