aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
authorEduardo Julian2017-11-14 01:24:03 -0400
committerEduardo Julian2017-11-14 01:24:03 -0400
commit4a43c41d139dfed45a8ed9b2308cf97fd6f3a59a (patch)
tree44d46a76e93a7cb7299e1faaeba3c9547f0f9372 /new-luxc
parent290c2389bc762dfaf625d72a76a675ce15119985 (diff)
- Added hashing to avoid collisions in case-insensitive file-systems.
Diffstat (limited to 'new-luxc')
-rw-r--r--new-luxc/source/luxc/lang/translation/common.jvm.lux7
-rw-r--r--new-luxc/source/luxc/lang/translation/reference.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation/statement.jvm.lux14
3 files changed, 13 insertions, 12 deletions
diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux
index baafc233a..4ec487d86 100644
--- a/new-luxc/source/luxc/lang/translation/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux
@@ -8,7 +8,8 @@
text/format
(coll [dict #+ Dict]))
[host]
- (world [blob #+ Blob]))
+ (world [blob #+ Blob]
+ [file #+ File]))
(luxc (lang [";L" variable #+ Register])
(host ["$" jvm]
(jvm ["$t" type]
@@ -27,11 +28,11 @@
(host;import java.lang.ClassLoader
(loadClass [String] (Class Object)))
-(type: #export Bytecode (host;type (Array byte)))
+(type: #export Bytecode Blob)
(type: #export Class-Store (A;Atom (Dict Text Bytecode)))
-(type: #export Artifacts (Dict Text Blob))
+(type: #export Artifacts (Dict File Blob))
(type: #export Host
{#loader ClassLoader
diff --git a/new-luxc/source/luxc/lang/translation/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
index 8e229af9c..e9c445dd4 100644
--- a/new-luxc/source/luxc/lang/translation/reference.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
@@ -1,7 +1,7 @@
(;module:
lux
(lux (control [monad #+ do])
- (data [text]
+ (data [text "text/" Hash<Text>]
text/format)
[meta "meta/" Monad<Meta>])
(luxc ["&" base]
@@ -43,5 +43,5 @@
(def: #export (translate-definition [def-module def-name])
(-> Ident (Meta $;Inst))
- (let [bytecode-name (format def-module "/" (&;normalize-name def-name))]
+ (let [bytecode-name (format def-module "/" (&;normalize-name def-name) (%n (text/hash def-name)))]
(meta/wrap ($i;GETSTATIC bytecode-name commonT;value-field commonT;$Object))))
diff --git a/new-luxc/source/luxc/lang/translation/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
index 1cef99c76..718175df1 100644
--- a/new-luxc/source/luxc/lang/translation/statement.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
@@ -4,7 +4,7 @@
["ex" exception #+ exception:])
(data ["e" error]
[maybe]
- [text "text/" Monoid<Text>]
+ [text "text/" Monoid<Text> Hash<Text>]
text/format
(coll [list "list/" Functor<List> Fold<List>]))
[meta]
@@ -37,7 +37,7 @@
(do meta;Monad<Meta>
[current-module meta;current-module-name
#let [def-ident [current-module def-name]
- normal-name (&;normalize-name def-name)
+ normal-name (format (&;normalize-name def-name) (%n (text/hash def-name)))
bytecode-name (format current-module "/" normal-name)
class-name (format current-module "." normal-name)
bytecode ($d;class #$;V1.6
@@ -57,17 +57,17 @@
[field (Class.getField [commonT;value-field] class)]
(Field.get [#;None] field))
(#e;Success #;None)
- (&;throw Invalid-Definition-Value (%ident [current-module def-name]))
+ (&;throw Invalid-Definition-Value (%ident def-ident))
(#e;Success (#;Some valueV))
(wrap valueV)
(#e;Error error)
(&;throw Cannot-Evaluate-Definition
- (format "Definition: " (%ident [current-module def-name]) "\n"
+ (format "Definition: " (%ident def-ident) "\n"
"Error:\n"
error))))
- _ (&module;define [current-module def-name] [valueT metaV valueV])
+ _ (&module;define def-ident [valueT metaV valueV])
_ (if (meta;type? metaV)
(case (meta;declared-tags metaV)
#;Nil
@@ -76,8 +76,8 @@
tags
(&module;declare-tags tags (meta;export? metaV) (:! Type valueV)))
(wrap []))
- #let [_ (log! (format "DEF " (%ident [current-module def-name])))]]
- (commonT;record-artifact bytecode-name bytecode)))
+ #let [_ (log! (format "DEF " (%ident def-ident)))]]
+ (commonT;record-artifact (format bytecode-name ".class") bytecode)))
(def: #export (translate-program program-args programI)
(-> Text $;Inst (Meta Unit))