diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation')
6 files changed, 127 insertions, 113 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index cf04d2a1a..8e2cd2af6 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Definition) + [lux (#- Module Definition) ["." host (#+ import: do-to object)] [abstract [monad (#+ do)]] @@ -25,7 +25,10 @@ ["." descriptor]]]] [tool [compiler - ["." name]]]] + [meta + [archive + [descriptor (#+ Module)] + ["." artifact]]]]]] [/// [host ["." jvm (#+ Inst Definition Host State) @@ -97,11 +100,9 @@ (-> Text Text) (text.replace-all .module-separator ..class-path-separator)) -(def: #export (class-name [module name]) - (-> Name Text) - (format (text.replace-all .module-separator ..class-path-separator module) - ..class-path-separator (name.normalize name) - "___" (%.nat (text@hash name)))) +(def: #export (class-name module id) + (-> Module artifact.ID Text) + (format (..class-name' module) ..class-path-separator (%.nat id))) (def: (evaluate! library loader eval-class valueI) (-> Library ClassLoader Text Inst (Try [Any Definition])) @@ -138,9 +139,9 @@ (loader.store class-name class-bytecode library))] (loader.load class-name loader)))) -(def: (define! library loader definition-name valueI) - (-> Library ClassLoader Name Inst (Try [Text Any Definition])) - (let [class-name (..class-name definition-name)] +(def: (define! library loader module id valueI) + (-> Library ClassLoader Module artifact.ID Inst (Try [Text Any Definition])) + (let [class-name (..class-name module id)] (do try.monad [[value definition] (evaluate! library loader class-name valueI)] (wrap [class-name value definition])))) @@ -152,9 +153,8 @@ (: Host (structure (def: (evaluate! temp-label valueI) - (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))] - (:: try.monad map product.left - (..evaluate! library loader eval-class valueI)))) + (:: try.monad map product.left + (..evaluate! library loader (text.replace-all " " "$" temp-label) valueI))) (def: execute! (..execute! library loader)) diff --git a/new-luxc/source/luxc/lang/translation/jvm/expression.lux b/new-luxc/source/luxc/lang/translation/jvm/expression.lux index 800f79a41..441758fec 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/expression.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/expression.lux @@ -45,7 +45,7 @@ (reference.variable variable) (^ (synthesis.constant constant)) - (reference.constant constant) + (reference.constant archive constant) (^ (synthesis.branch/let data)) (case.let translate archive data) diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux index 7569a825e..cf039db68 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux @@ -946,87 +946,89 @@ ## (:: type.equivalence = type.double returnT) _.DRETURN)))) -(def: class::anonymous - Handler - (..custom - [($_ <>.and - <s>.text - ..class - (<s>.tuple (<>.some ..class)) - (<s>.tuple (<>.some ..input)) - (<s>.tuple (<>.some ..overriden-method-definition))) - (function (_ extension-name generate archive [class-name - super-class super-interfaces - inputsTS - overriden-methods]) - (do phase.monad - [#let [class (type.class class-name (list)) - total-environment (|> overriden-methods - ## Get all the environments. - (list@map product.left) - ## Combine them. - list@join - ## Remove duplicates. - (set.from-list reference.hash) - set.to-list) - global-mapping (|> total-environment - ## Give them names as "foreign" variables. - list.enumerate - (list@map (function (_ [id capture]) - [capture (#reference.Foreign id)])) - (dictionary.from-list reference.hash)) - normalized-methods (list@map (function (_ [environment - [ownerT name - strict-fp? annotations vars - self-name arguments returnT exceptionsT - body]]) - (let [local-mapping (|> environment - list.enumerate - (list@map (function (_ [foreign-id capture]) - [(#reference.Foreign foreign-id) - (|> global-mapping - (dictionary.get capture) - maybe.assume)])) - (dictionary.from-list reference.hash))] - [ownerT name - strict-fp? annotations vars - self-name arguments returnT exceptionsT - (normalize-method-body local-mapping body)])) - overriden-methods)] - inputsTI (monad.map @ (generate-input generate archive) inputsTS) - method-definitions (|> normalized-methods - (monad.map @ (function (_ [ownerT name - strict-fp? annotations vars - self-name arguments returnT exceptionsT - bodyS]) - (do @ - [bodyG (generation.with-specific-context class-name - (generate archive bodyS))] - (wrap (_def.method #$.Public - (if strict-fp? - ($_ $.++M $.finalM $.strictM) - $.finalM) - name - (type.method [(list@map product.right arguments) - returnT - exceptionsT]) - (|>> bodyG (returnI returnT))))))) - (:: @ map _def.fuse)) - _ (generation.save! true ["" class-name] - [class-name - (_def.class #$.V1_6 #$.Public $.finalC - 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 class total-environment)))])) +## TODO: Uncomment ASAP +## (def: class::anonymous +## Handler +## (..custom +## [($_ <>.and +## <s>.text +## ..class +## (<s>.tuple (<>.some ..class)) +## (<s>.tuple (<>.some ..input)) +## (<s>.tuple (<>.some ..overriden-method-definition))) +## (function (_ extension-name generate archive [class-name +## super-class super-interfaces +## inputsTS +## overriden-methods]) +## (do phase.monad +## [#let [class (type.class class-name (list)) +## total-environment (|> overriden-methods +## ## Get all the environments. +## (list@map product.left) +## ## Combine them. +## list@join +## ## Remove duplicates. +## (set.from-list reference.hash) +## set.to-list) +## global-mapping (|> total-environment +## ## Give them names as "foreign" variables. +## list.enumerate +## (list@map (function (_ [id capture]) +## [capture (#reference.Foreign id)])) +## (dictionary.from-list reference.hash)) +## normalized-methods (list@map (function (_ [environment +## [ownerT name +## strict-fp? annotations vars +## self-name arguments returnT exceptionsT +## body]]) +## (let [local-mapping (|> environment +## list.enumerate +## (list@map (function (_ [foreign-id capture]) +## [(#reference.Foreign foreign-id) +## (|> global-mapping +## (dictionary.get capture) +## maybe.assume)])) +## (dictionary.from-list reference.hash))] +## [ownerT name +## strict-fp? annotations vars +## self-name arguments returnT exceptionsT +## (normalize-method-body local-mapping body)])) +## overriden-methods)] +## inputsTI (monad.map @ (generate-input generate archive) inputsTS) +## method-definitions (|> normalized-methods +## (monad.map @ (function (_ [ownerT name +## strict-fp? annotations vars +## self-name arguments returnT exceptionsT +## bodyS]) +## (do @ +## [bodyG (generation.with-specific-context class-name +## (generate archive bodyS))] +## (wrap (_def.method #$.Public +## (if strict-fp? +## ($_ $.++M $.finalM $.strictM) +## $.finalM) +## name +## (type.method [(list@map product.right arguments) +## returnT +## exceptionsT]) +## (|>> bodyG (returnI returnT))))))) +## (:: @ map _def.fuse)) +## _ (generation.save! true ["" class-name] +## [class-name +## (_def.class #$.V1_6 #$.Public $.finalC +## 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 class total-environment)))])) (def: bundle::class Bundle (<| (bundle.prefix "class") (|> (: Bundle bundle.empty) - (bundle.install "anonymous" class::anonymous) + ## TODO: Uncomment ASAP + ## (bundle.install "anonymous" class::anonymous) ))) (def: #export bundle diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux index 72c77f2a2..449855aca 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux @@ -32,7 +32,7 @@ ["." def] ["_" inst]]]]] ["." // - ["." runtime] + ["#." runtime] ["." reference]]) (def: arity-field Text "arity") @@ -61,7 +61,7 @@ (def: get-amount-of-partialsI Inst (|>> (_.ALOAD 0) - (_.GETFIELD //.$Function runtime.partials-field type.int))) + (_.GETFIELD //.$Function //runtime.partials-field type.int))) (def: (load-fieldI class field) (-> (Type Class) Text Inst) @@ -76,13 +76,13 @@ (def: (applysI start amount) (-> Register Nat Inst) - (let [max-args (n.min amount runtime.num-apply-variants) - later-applysI (if (n.> runtime.num-apply-variants amount) - (applysI (n.+ runtime.num-apply-variants start) (n.- runtime.num-apply-variants amount)) + (let [max-args (n.min amount //runtime.num-apply-variants) + later-applysI (if (n.> //runtime.num-apply-variants amount) + (applysI (n.+ //runtime.num-apply-variants start) (n.- //runtime.num-apply-variants amount)) function.identity)] (|>> (_.CHECKCAST //.$Function) (inputsI start max-args) - (_.INVOKEVIRTUAL //.$Function runtime.apply-method (runtime.apply-signature max-args)) + (_.INVOKEVIRTUAL //.$Function //runtime.apply-method (//runtime.apply-signature max-args)) later-applysI))) (def: (inc-intI by) @@ -243,7 +243,7 @@ _.ARETURN)) )))) _.fuse)] - (def.method #$.Public $.noneM runtime.apply-method (runtime.apply-signature apply-arity) + (def.method #$.Public $.noneM //runtime.apply-method (//runtime.apply-signature apply-arity) (|>> get-amount-of-partialsI (_.TABLESWITCH +0 (|> num-partials dec .int) @default @labels) @@ -272,12 +272,12 @@ (let [classD (type.class class (list)) applyD (: Def (if (poly-arg? arity) - (|> (n.min arity runtime.num-apply-variants) + (|> (n.min arity //runtime.num-apply-variants) (list.n/range 1) (list@map (with-apply classD env arity @begin bodyI)) (list& (with-implementation arity @begin bodyI)) def.fuse) - (def.method #$.Public $.strictM runtime.apply-method (runtime.apply-signature 1) + (def.method #$.Public $.strictM //runtime.apply-method (//runtime.apply-signature 1) (|>> (_.label @begin) bodyI _.ARETURN)))) @@ -297,10 +297,10 @@ (Generator Abstraction) (do phase.monad [@begin _.make-label - [function-class bodyI] (generation.with-context - (generation.with-anchor [@begin 1] - (generate archive bodyS))) - #let [function-class (//.class-name' function-class)] + [function-context bodyI] (generation.with-new-context + (generation.with-anchor [@begin 1] + (generate archive bodyS))) + #let [function-class (//runtime.class-name function-context)] [functionD instanceI] (with-function @begin function-class env arity bodyI) _ (generation.save! true ["" function-class] [function-class @@ -316,11 +316,11 @@ [functionI (generate archive functionS) argsI (monad.map @ (generate archive) argsS) #let [applyI (|> argsI - (list.split-all runtime.num-apply-variants) + (list.split-all //runtime.num-apply-variants) (list@map (.function (_ chunkI+) (|>> (_.CHECKCAST //.$Function) (_.fuse chunkI+) - (_.INVOKEVIRTUAL //.$Function runtime.apply-method (runtime.apply-signature (list.size chunkI+)))))) + (_.INVOKEVIRTUAL //.$Function //runtime.apply-method (//runtime.apply-signature (list.size chunkI+)))))) _.fuse)]] (wrap (|>> functionI applyI)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.lux index ba5cb33de..ff5d7a96c 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.lux @@ -10,9 +10,10 @@ ["." type]]] [tool [compiler - ["." name] ["." reference (#+ Register Variable)] ["." phase ("operation@." monad)] + [meta + [archive (#+ Archive)]] [language [lux ["." generation]]]]]] @@ -21,7 +22,8 @@ [host [jvm (#+ Inst Operation) ["_" inst]]]]] - ["." //]) + ["." // + ["#." runtime]]) (template [<name> <prefix>] [(def: #export <name> @@ -35,9 +37,10 @@ (def: (foreign variable) (-> Register (Operation Inst)) (do phase.monad - [function-class generation.context] + [class-name (:: @ map //runtime.class-name + generation.context)] (wrap (|>> (_.ALOAD 0) - (_.GETFIELD (type.class function-class (list)) + (_.GETFIELD (type.class class-name (list)) (|> variable .nat foreign-name) //.$Value))))) @@ -54,8 +57,9 @@ (#reference.Foreign variable) (foreign variable))) -(def: #export (constant name) - (-> Name (Operation Inst)) +(def: #export (constant archive name) + (-> Archive Name (Operation Inst)) (do phase.monad - [bytecode-name (generation.remember name)] - (wrap (_.GETSTATIC (type.class bytecode-name (list)) //.value-field //.$Value)))) + [class-name (:: @ map //runtime.class-name + (generation.remember archive name))] + (wrap (_.GETSTATIC (type.class class-name (list)) //.value-field //.$Value)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux index 72763d01f..eb3ed9b7f 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux @@ -3,6 +3,8 @@ [abstract [monad (#+ do)]] [data + [text + ["%" format (#+ format)]] [collection ["." list ("#@." functor)]]] ["." math] @@ -27,6 +29,12 @@ ["_" inst]]]]] ["." // (#+ ByteCode)]) +(def: prefix "lux/") + +(def: #export (class-name [module id]) + (-> generation.Context Text) + (format ..prefix module "/" (%.nat id))) + (def: $Text (type.class "java.lang.String" (list))) (def: #export $Tag type.int) (def: #export $Flag (type.class "java.lang.Object" (list))) |