diff options
Diffstat (limited to 'new-luxc/source/luxc/lang')
| -rw-r--r-- | new-luxc/source/luxc/lang/host.jvm.lux | 4 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/def.lux | 10 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/inst.lux | 4 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation.lux | 50 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/common.jvm.lux | 62 |
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)))))))) |