diff options
Diffstat (limited to '')
| -rw-r--r-- | lux-jvm/source/luxc/lang/translation/jvm.lux | 22 | ||||
| -rw-r--r-- | lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux | 58 | ||||
| -rw-r--r-- | lux-jvm/source/luxc/lang/translation/jvm/function.lux | 60 | ||||
| -rw-r--r-- | lux-jvm/source/luxc/lang/translation/jvm/runtime.lux | 27 | ||||
| -rw-r--r-- | lux-jvm/source/program.lux | 1 |
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 |