aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/host.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux10
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation.lux50
-rw-r--r--new-luxc/source/luxc/lang/translation/common.jvm.lux62
5 files changed, 86 insertions, 44 deletions
diff --git a/new-luxc/source/luxc/lang/host.jvm.lux b/new-luxc/source/luxc/lang/host.jvm.lux
index c980eab9d..6eb8aacbc 100644
--- a/new-luxc/source/luxc/lang/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/host.jvm.lux
@@ -56,8 +56,8 @@
(Method::invoke [loader
(array.from-list (list (:! Object class-name)
(:! Object byte-code)
- (:! Object (host.l2i 0))
- (:! Object (host.l2i (nat-to-int (host.array-length byte-code))))))]
+ (:! Object (host.long-to-int 0))
+ (:! Object (host.long-to-int (nat-to-int (host.array-length byte-code))))))]
ClassLoader::defineClass))
(def: (fetch-byte-code class-name store)
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index 8e90172d5..8c73c1086 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -266,13 +266,13 @@
writer)))]
[boolean-field Bool $t.boolean id]
- [byte-field Int $t.byte host.l2b]
- [short-field Int $t.short host.l2s]
- [int-field Int $t.int host.l2i]
+ [byte-field Int $t.byte host.long-to-byte]
+ [short-field Int $t.short host.long-to-short]
+ [int-field Int $t.int host.long-to-int]
[long-field Int $t.long id]
- [float-field Frac $t.float host.d2f]
+ [float-field Frac $t.float host.double-to-float]
[double-field Frac $t.double id]
- [char-field Nat $t.char (|>> nat-to-int host.l2i host.i2c)]
+ [char-field Nat $t.char (|>> nat-to-int host.long-to-int host.int-to-char)]
[string-field Text ($t.class "java.lang.String" (list)) id]
)
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index 5f3711bbd..0b1904020 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -128,10 +128,10 @@
(MethodVisitor::visitLdcInsn [(<prepare> value)]))))]
[boolean Bool id]
- [int Int host.l2i]
+ [int Int host.long-to-int]
[long Int id]
[double Frac id]
- [char Nat (|>> nat-to-int host.l2i host.i2c)]
+ [char Nat (|>> nat-to-int host.long-to-int host.int-to-char)]
[string Text id]
)
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index a0e5bca97..b1e65c952 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -4,7 +4,8 @@
["ex" exception #+ exception:])
(concurrency ["P" promise]
["T" task])
- (data ["e" error]
+ (data [product]
+ ["e" error]
[text "text/" Hash<Text>]
text/format
(coll [list "list/" Functor<List>]
@@ -14,9 +15,13 @@
(type ["tc" check]))
[host]
[io #+ IO Process io]
- (world [file #+ File]))
+ (world [blob #+ Blob]
+ [file #+ File]))
(luxc ["&" lang]
["&." io]
+ [cache]
+ [cache/description]
+ [cache/io]
(lang [".L" module]
[".L" host]
[".L" macro]
@@ -35,9 +40,7 @@
[".T" expression]
[".T" eval]
[".T" imports])
- ["&." eval]
- ## [".L" cache]
- )
+ ["&." eval])
))
(def: analyse
@@ -156,27 +159,30 @@
(#e.Success [(set@ #.source source' compiler)
output]))))
-(def: (write-module target-dir module-name module artifacts)
- (-> File Text Module Artifacts (Process Unit))
+(for {"JVM" (as-is (host.import java/lang/String
+ (getBytes [String] #try (Array byte)))
+
+ (def: text-to-blob
+ (-> Text Blob)
+ (|>> (:! String)
+ (String::getBytes ["UTF-8"])
+ e.assume)))})
+
+(def: (write-module target-dir file-name module-name module artifacts)
+ (-> File Text Text Module Artifacts (Process Unit))
(do io.Monad<Process>
- [_ (monad.map @ (function [[name content]]
- (&io.write target-dir
- (format module-name "/" name (for {"JVM" ".class"
- "JS" ".js"}))
- content))
+ [_ (monad.map @ (product.uncurry (&io.write target-dir))
(dict.entries artifacts))]
- (wrap [])
- ## (&io.write (format module-dir "/" cacheL.descriptor-name)
- ## (text-to-blob (%code (cacheL.describe module))))
- ))
+ (&io.write target-dir
+ (format module-name "/" cache.descriptor-name)
+ (text-to-blob (%code (cache/description.write file-name module))))))
(def: no-aliases Aliases (dict.new text.Hash<Text>))
(def: #export (translate-module source-dirs target-dir module-name compiler)
(-> (List File) File Text Compiler (Process Compiler))
(do io.Monad<Process>
- [## _ (&io.prepare-module target-dir module-name)
- [file-name file-content] (&io.read-module source-dirs module-name)
+ [[file-name file-content] (&io.read source-dirs module-name)
#let [module-hash (text/hash file-content)
translate-module (translate-module source-dirs target-dir)]]
(case (macro.run' compiler
@@ -197,8 +203,8 @@
(wrap [module artifacts])))
(#e.Success [compiler [module artifacts]])
(do @
- [## _ (write-module target-dir module-name module artifacts)
- ]
+ [_ (&io.prepare-module target-dir module-name)
+ _ (write-module target-dir file-name module-name module artifacts)]
(wrap compiler))
(#e.Error error)
@@ -246,7 +252,8 @@
(do @
[_ (&io.prepare-target target)
_ (&io.write target (format hostL.runtime-class ".class") runtime-bc)
- _ (&io.write target (format hostL.function-class ".class") function-bc)]
+ _ (&io.write target (format hostL.function-class ".class") function-bc)
+ _ (cache/io.pre-load sources target (commonT.load-definition compiler))]
(wrap (set@ #.extensions
(:! Void
{#extensionL.analysis analysisE.defaults
@@ -261,5 +268,6 @@
(do io.Monad<Process>
[compiler (initialize sources target)
_ (translate-module sources target program compiler)
+ ## _ (cache/io.clean target ...)
#let [_ (log! "Compilation complete!")]]
(wrap [])))
diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux
index 1132928d0..a4eb5b93b 100644
--- a/new-luxc/source/luxc/lang/translation/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux
@@ -1,16 +1,19 @@
(.module:
- [lux #- function]
- (lux (control ["ex" exception #+ exception:])
+ lux
+ (lux (control [monad #+ do]
+ ["ex" exception #+ exception:])
[io]
(concurrency [atom #+ Atom atom])
- (data ["e" error]
- [text]
+ (data ["e" error #+ Error]
+ [text "text/" Hash<Text>]
text/format
(coll [dict #+ Dict]))
+ [macro]
[host]
(world [blob #+ Blob]
[file #+ File]))
- (luxc (lang [".L" variable #+ Register]
+ (luxc [lang]
+ (lang [".L" variable #+ Register]
(host ["$" jvm]
(jvm ["$t" type]
["$d" def]
@@ -23,7 +26,11 @@
(host.import java/lang/Object)
-(host.import (java/lang/Class a))
+(host.import java/lang/reflect/Field
+ (get [#? Object] #try #? Object))
+
+(host.import (java/lang/Class c)
+ (getField [String] #try Field))
(host.import java/lang/ClassLoader
(loadClass [String] (Class Object)))
@@ -41,14 +48,16 @@
#context [Text Nat]
#anchor (Maybe [Label Register])})
-(exception: Unknown-Class)
-(exception: Class-Already-Stored)
-(exception: No-Function-Being-Compiled)
-(exception: Cannot-Overwrite-Artifact)
+(exception: #export Unknown-Class)
+(exception: #export Class-Already-Stored)
+(exception: #export No-Function-Being-Compiled)
+(exception: #export Cannot-Overwrite-Artifact)
+(exception: #export Cannot-Load-Definition)
+(exception: #export Invalid-Definition-Value)
(def: #export (with-artifacts action)
(All [a] (-> (Meta a) (Meta [Artifacts a])))
- (.function [compiler]
+ (function [compiler]
(case (action (update@ #.host
(|>> (:! Host)
(set@ #artifacts (dict.new text.Hash<Text>))
@@ -68,7 +77,7 @@
(def: #export (record-artifact name content)
(-> Text Blob (Meta Unit))
- (.function [compiler]
+ (function [compiler]
(if (|> compiler (get@ #.host) (:! Host) (get@ #artifacts) (dict.contains? name))
(ex.throw Cannot-Overwrite-Artifact name)
(#e.Success [(update@ #.host
@@ -80,7 +89,7 @@
(def: #export (store-class name byte-code)
(-> Text Bytecode (Meta Unit))
- (.function [compiler]
+ (function [compiler]
(let [store (|> (get@ #.host compiler)
(:! Host)
(get@ #store))]
@@ -91,7 +100,7 @@
(def: #export (load-class name)
(-> Text (Meta (Class Object)))
- (.function [compiler]
+ (function [compiler]
(let [host (:! Host (get@ #.host compiler))
store (|> host (get@ #store) atom.read io.run)]
(if (dict.contains? name store)
@@ -100,3 +109,28 @@
(def: #export value-field Text "_value")
(def: #export $Object $.Type ($t.class "java.lang.Object" (list)))
+
+(def: #export (load-definition compiler)
+ (-> Compiler
+ (-> Ident Blob (Error Top)))
+ (function [(^@ def-ident [def-module def-name]) def-bytecode]
+ (let [normal-name (format (lang.normalize-name def-name) (%n (text/hash def-name)))
+ class-name (format (text.replace-all "/" "." def-module) "." normal-name)]
+ (<| (macro.run compiler)
+ (do macro.Monad<Meta>
+ [_ (..store-class class-name def-bytecode)
+ class (..load-class class-name)]
+ (case (do e.Monad<Error>
+ [field (Class::getField [..value-field] class)]
+ (Field::get [#.None] field))
+ (#e.Success (#.Some def-value))
+ (wrap def-value)
+
+ (#e.Success #.None)
+ (lang.throw Invalid-Definition-Value (%ident def-ident))
+
+ (#e.Error error)
+ (lang.throw Cannot-Load-Definition
+ (format "Definition: " (%ident def-ident) "\n"
+ "Error:\n"
+ error))))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 18:12:28 +0000