From 6b8678f818a5f7399a50f4e2108d96783d22fd67 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 19 Mar 2020 21:18:58 -0400
Subject: Got the new compiler to build again.
---
new-luxc/source/luxc/lang/translation/jvm.lux | 26 ++--
.../luxc/lang/translation/jvm/expression.lux | 2 +-
.../luxc/lang/translation/jvm/extension/host.lux | 154 +++++++++++----------
.../source/luxc/lang/translation/jvm/function.lux | 30 ++--
.../source/luxc/lang/translation/jvm/reference.lux | 20 +--
.../source/luxc/lang/translation/jvm/runtime.lux | 8 ++
new-luxc/source/program.lux | 1 +
7 files changed, 128 insertions(+), 113 deletions(-)
(limited to 'new-luxc/source')
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)))
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index 5fbbd0537..61840abf0 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -157,6 +157,7 @@
analysis.bundle
..platform
@.jvm
+ module
## generation.bundle
translation.bundle
(directive.bundle extender)
--
cgit v1.2.3