aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/extension/host.lux160
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