diff options
Diffstat (limited to 'new-luxc/source/luxc/lang')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/extension/host.lux | 160 |
1 files changed, 80 insertions, 80 deletions
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 408b2a389..d448d182c 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux @@ -12,7 +12,8 @@ [data ["." product] ["." maybe] - ["." text ("#@." equivalence)] + ["." text ("#@." equivalence) + ["%" format (#+ format)]] [number ["." nat]] [collection @@ -56,7 +57,7 @@ ["_." def]]]]] ["." // #_ [common (#+ custom)] - ["/#" // #_ + ["/#" // ["#." reference] ["#." function]]]) @@ -946,89 +947,88 @@ ## (:: type.equivalence = type.double returnT) _.DRETURN)))) -## 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: class::anonymous + Handler + (..custom + [($_ <>.and + ..class + (<s>.tuple (<>.some ..class)) + (<s>.tuple (<>.some ..input)) + (<s>.tuple (<>.some ..overriden-method-definition))) + (function (_ extension-name generate archive [super-class super-interfaces + inputsTS + overriden-methods]) + (do phase.monad + [[context _] (generation.with-new-context archive (wrap [])) + #let [[module-id artifact-id] context + anonymous-class-name (///.class-name context) + class (type.class anonymous-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-context artifact-id + (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 ["" (%.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)))])) (def: bundle::class Bundle (<| (bundle.prefix "class") (|> (: Bundle bundle.empty) - ## TODO: Uncomment ASAP - ## (bundle.install "anonymous" class::anonymous) + (bundle.install "anonymous" class::anonymous) ))) (def: #export bundle |