aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/init.lux2
-rw-r--r--new-luxc/source/luxc/lang/synthesis/expression.lux8
-rw-r--r--new-luxc/source/luxc/lang/translation.lux145
-rw-r--r--new-luxc/source/luxc/lang/translation/js.lux246
-rw-r--r--new-luxc/source/luxc/lang/translation/js/case.jvm.lux54
-rw-r--r--new-luxc/source/luxc/lang/translation/js/eval.jvm.lux164
-rw-r--r--new-luxc/source/luxc/lang/translation/js/expression.jvm.lux32
-rw-r--r--new-luxc/source/luxc/lang/translation/js/function.jvm.lux13
-rw-r--r--new-luxc/source/luxc/lang/translation/js/imports.jvm.lux64
-rw-r--r--new-luxc/source/luxc/lang/translation/js/loop.jvm.lux19
-rw-r--r--new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux90
-rw-r--r--new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux14
-rw-r--r--new-luxc/source/luxc/lang/translation/js/reference.jvm.lux21
-rw-r--r--new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux27
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux8
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux11
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux3
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux3
18 files changed, 594 insertions, 330 deletions
diff --git a/new-luxc/source/luxc/lang/init.lux b/new-luxc/source/luxc/lang/init.lux
index 80968d7cd..55e02d0b6 100644
--- a/new-luxc/source/luxc/lang/init.lux
+++ b/new-luxc/source/luxc/lang/init.lux
@@ -30,7 +30,7 @@
#.mode #.Build})
(def: #export (compiler host)
- (-> commonT.Host Compiler)
+ (-> Top Compiler)
{#.info ..info
#.source dummy-source
#.cursor .dummy-cursor
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
index 2dbf8ed5a..b17af14d2 100644
--- a/new-luxc/source/luxc/lang/synthesis/expression.lux
+++ b/new-luxc/source/luxc/lang/synthesis/expression.lux
@@ -114,7 +114,7 @@
_
(call$ funcS argsS))))
-(def: #export (synthesize syntheses expressionA)
+(def: #export (synthesize extensions expressionA)
(-> Syntheses la.Analysis ls.Synthesis)
(loop [arity +0
resolver init-resolver
@@ -191,12 +191,12 @@
(synthesize-apply (recur arity resolver false num-locals) num-locals expressionA)
(^code ((~ [_ (#.Text name)]) (~+ args)))
- (case (dict.get name syntheses)
+ (case (dict.get name extensions)
#.None
(procedure$ name (list/map (recur arity resolver false num-locals) args))
- (#.Some synthesis)
- (synthesis (recur arity resolver false num-locals) args))
+ (#.Some extension)
+ (extension (recur arity resolver false num-locals) args))
_
expressionA)))
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index da465a804..30c4ec33c 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -36,12 +36,13 @@
[".A" common])
(synthesis [".S" expression])
["&." eval]))
- (/ (jvm [".T" runtime]
- [".T" statement]
- [".T" common #+ Artifacts]
- [".T" expression]
- [".T" eval]
- [".T" imports])))
+ (/ [js]
+ (js [".T" runtime]
+ [".T" statement]
+ ## [".T" common #+ Artifacts]
+ [".T" expression]
+ [".T" eval]
+ [".T" imports])))
(def: analyse
(&.Analyser)
@@ -52,7 +53,9 @@
(exception: #export Invalid-Macro)
(def: (process-annotations annsC)
- (-> Code (Meta [$.Inst Code]))
+ (-> Code (Meta [js.Expression
+ ## $.Inst
+ Code]))
(do macro.Monad<Meta>
[[_ annsA] (&.with-scope
(&.with-type Code
@@ -168,14 +171,14 @@
(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 @ (product.uncurry (&io.write target-dir))
- (dict.entries artifacts))]
- (&io.write target-dir
- (format module-name "/" cache.descriptor-name)
- (text-to-blob (%code (cache/description.write file-name module))))))
+## (def: (write-module target-dir file-name module-name module artifacts)
+## (-> File Text Text Module Artifacts (Process Unit))
+## (do io.Monad<Process>
+## [_ (monad.map @ (product.uncurry (&io.write target-dir))
+## (dict.entries artifacts))]
+## (&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>))
@@ -187,21 +190,20 @@
translate-module (translate-module source-dirs target-dir)]]
(case (macro.run' compiler
(do macro.Monad<Meta>
- [[module artifacts _] (moduleL.with-module module-hash module-name
- (commonT.with-artifacts
- (with-active-compilation [module-name
- file-name
- file-content]
- (forgive-eof
- (loop [aliases no-aliases]
- (do @
- [code (read module-name aliases)
- #let [[cursor _] code]
- aliases' (&.with-cursor cursor
- (translate translate-module aliases code))]
- (forgive-eof (recur aliases'))))))))]
- (wrap [module artifacts])))
- (#e.Success [compiler [module artifacts]])
+ [[module _] (moduleL.with-module module-hash module-name
+ (with-active-compilation [module-name
+ file-name
+ file-content]
+ (forgive-eof
+ (loop [aliases no-aliases]
+ (do @
+ [code (read module-name aliases)
+ #let [[cursor _] code]
+ aliases' (&.with-cursor cursor
+ (translate translate-module aliases code))]
+ (forgive-eof (recur aliases')))))))]
+ (wrap module)))
+ (#e.Success [compiler module])
(do @
[## _ (&io.prepare-module target-dir module-name)
## _ (write-module target-dir file-name module-name module artifacts)
@@ -209,30 +211,73 @@
(wrap compiler))
(#e.Error error)
- (io.fail error))))
+ (io.fail error))
+ ## (case (macro.run' compiler
+ ## (do macro.Monad<Meta>
+ ## [[module artifacts _] (moduleL.with-module module-hash module-name
+ ## (commonT.with-artifacts
+ ## (with-active-compilation [module-name
+ ## file-name
+ ## file-content]
+ ## (forgive-eof
+ ## (loop [aliases no-aliases]
+ ## (do @
+ ## [code (read module-name aliases)
+ ## #let [[cursor _] code]
+ ## aliases' (&.with-cursor cursor
+ ## (translate translate-module aliases code))]
+ ## (forgive-eof (recur aliases'))))))))]
+ ## (wrap [module artifacts])))
+ ## (#e.Success [compiler [module artifacts]])
+ ## (do @
+ ## [## _ (&io.prepare-module target-dir module-name)
+ ## ## _ (write-module target-dir file-name module-name module artifacts)
+ ## ]
+ ## (wrap compiler))
+
+ ## (#e.Error error)
+ ## (io.fail error))
+ ))
(def: (initialize sources target)
(-> (List File) File (Process Compiler))
(do io.Monad<Process>
- [compiler (: (Process Compiler)
- (case (runtimeT.translate (initL.compiler (io.run hostL.init-host)))
- (#e.Error error)
- (io.fail error)
-
- (#e.Success [compiler [runtime-bc function-bc]])
- (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)
- _ (cache/io.pre-load sources target (commonT.load-definition compiler))]
- (wrap (|> compiler
- (set@ [#.info #.mode] #.Build)
- (set@ #.extensions
- (:! Void
- {#extensionL.analysis analysisE.defaults
- #extensionL.synthesis synthesisE.defaults
- #extensionL.translation translationE.defaults
- #extensionL.statement statementE.defaults})))))))]
+ [compiler (case (runtimeT.translate (initL.compiler (io.run js.init))
+ ## (initL.compiler (io.run hostL.init-host))
+ )
+ (#e.Success [compiler disk-write])
+ (do @
+ [_ (&io.prepare-target target)
+ _ disk-write
+ ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
+ ]
+ (wrap (|> compiler
+ (set@ [#.info #.mode] #.Build)
+ (set@ #.extensions
+ (:! Void
+ {#extensionL.analysis analysisE.defaults
+ #extensionL.synthesis synthesisE.defaults
+ #extensionL.translation translationE.defaults
+ #extensionL.statement statementE.defaults})))))
+
+ ## (#e.Success [compiler [runtime-bc function-bc]])
+ ## (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)
+ ## ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
+ ## ]
+ ## (wrap (|> compiler
+ ## (set@ [#.info #.mode] #.Build)
+ ## (set@ #.extensions
+ ## (:! Void
+ ## {#extensionL.analysis analysisE.defaults
+ ## #extensionL.synthesis synthesisE.defaults
+ ## #extensionL.translation translationE.defaults
+ ## #extensionL.statement statementE.defaults})))))
+
+ (#e.Error error)
+ (io.fail error))]
(translate-module sources target prelude compiler)))
(def: #export (translate-program sources target program)
diff --git a/new-luxc/source/luxc/lang/translation/js.lux b/new-luxc/source/luxc/lang/translation/js.lux
index fa056145d..9b1b2b503 100644
--- a/new-luxc/source/luxc/lang/translation/js.lux
+++ b/new-luxc/source/luxc/lang/translation/js.lux
@@ -10,10 +10,11 @@
text/format
(coll [array]))
[macro]
- [io #+ Process]
+ [io #+ IO Process io]
[host #+ class: interface: object]
(world [file #+ File]))
(luxc [lang]
+ (lang [".L" variable #+ Register])
[".C" io]))
(type: #export JS Text)
@@ -28,10 +29,6 @@
(host.import java/lang/String
(getBytes [String] #try (Array byte)))
-(host.import java/lang/Number
- (doubleValue [] double)
- (longValue [] Long))
-
(host.import java/lang/Integer
(longValue [] Long))
@@ -56,36 +53,30 @@
(host.import jdk/nashorn/api/scripting/NashornScriptEngine)
-(host.import jdk/nashorn/api/scripting/JSObject
- (isArray [] boolean)
- (isFunction [] boolean)
- (getMember [String] #? Object)
- (hasMember [String] boolean))
+(host.import jdk/nashorn/api/scripting/JSObject)
(host.import jdk/nashorn/api/scripting/AbstractJSObject)
-(host.import jdk/nashorn/api/scripting/ScriptObjectMirror
- (size [] int))
-
-(host.import jdk/nashorn/internal/runtime/Undefined)
-
(host.import java/util/Arrays
(#static [t] copyOfRange [(Array t) int int] (Array t)))
-(type: #export Host
- {## #artifacts Artifacts
- ## #context [Text Nat]
+(type: #export Anchor [Text Register])
+(type: #export Host
+ {#context [Text Nat]
+ #anchor (Maybe Anchor)
#interpreter ScriptEngine
#module-buffer (Maybe StringBuilder)
#program-buffer StringBuilder
})
-(def: #export (init _)
- (-> Top Host)
- {#interpreter (ScriptEngineFactory::getScriptEngine [] (NashornScriptEngineFactory::new []))
- #module-buffer #.None
- #program-buffer (StringBuilder::new [])})
+(def: #export init
+ (IO Host)
+ (io {#context ["" +0]
+ #anchor #.None
+ #interpreter (ScriptEngineFactory::getScriptEngine [] (NashornScriptEngineFactory::new []))
+ #module-buffer #.None
+ #program-buffer (StringBuilder::new [])}))
(def: #export module-js-name Text "module.js")
@@ -101,7 +92,66 @@
(exception: #export No-Active-Module-Buffer)
(exception: #export Cannot-Execute)
-(exception: #export Cannot-Evaluate)
+
+(def: #export (with-sub-context expr)
+ (All [a] (-> (Meta a) (Meta [Text a])))
+ (function [compiler]
+ (let [old (:! Host (get@ #.host compiler))
+ [old-name old-sub] (get@ #context old)
+ new-name (format old-name "$" (%i (nat-to-int old-sub)))]
+ (case (expr (set@ #.host
+ (:! Void (set@ #context [new-name +0] old))
+ compiler))
+ (#e.Success [compiler' output])
+ (#e.Success [(update@ #.host
+ (|>> (:! Host)
+ (set@ #context [old-name (n/inc old-sub)])
+ (:! Void))
+ compiler')
+ [new-name output]])
+
+ (#e.Error error)
+ (#e.Error error)))))
+
+(def: #export context
+ (Meta Text)
+ (function [compiler]
+ (#e.Success [compiler
+ (|> (get@ #.host compiler)
+ (:! Host)
+ (get@ #context)
+ (let> [name sub]
+ name))])))
+
+(def: #export (with-anchor anchor expr)
+ (All [a] (-> Anchor (Meta a) (Meta a)))
+ (function [compiler]
+ (let [old (:! Host (get@ #.host compiler))]
+ (case (expr (set@ #.host
+ (:! Void (set@ #anchor (#.Some anchor) old))
+ compiler))
+ (#e.Success [compiler' output])
+ (#e.Success [(update@ #.host
+ (|>> (:! Host)
+ (set@ #anchor (get@ #anchor old))
+ (:! Void))
+ compiler')
+ output])
+
+ (#e.Error error)
+ (#e.Error error)))))
+
+(exception: #export No-Anchor)
+
+(def: #export anchor
+ (Meta Anchor)
+ (function [compiler]
+ (case (|> compiler (get@ #.host) (:! Host) (get@ #anchor))
+ (#.Some anchor)
+ (#e.Success [compiler anchor])
+
+ #.None
+ ((lang.throw No-Anchor "") compiler))))
(def: #export module-buffer
(Meta StringBuilder)
@@ -157,8 +207,8 @@
(exception: #export Unknown-Member)
-(def: int-high-field Text "H")
-(def: int-low-field Text "L")
+(def: #export int-high-field Text "H")
+(def: #export int-low-field Text "L")
(def: jvm-int
(-> Nat Integer)
@@ -168,14 +218,13 @@
Nat
(|> +1 (bit.shift-left +32) n/dec))
-(def: high (-> Nat Nat) (bit.shift-right +32))
-(def: low (-> Nat Nat) (bit.and low-mask))
+(def: #export high (-> Nat Nat) (bit.shift-right +32))
+(def: #export low (-> Nat Nat) (bit.and low-mask))
(interface: IntValue
(getValue [] Long))
-(host.import luxc/lang/translation/js/IntValue
- (getValue [] Long))
+(host.import luxc/lang/translation/js/IntValue)
(def: (js-int value)
(-> Int JSObject)
@@ -198,8 +247,7 @@
(interface: StructureValue
(getValue [] (Array Object)))
-(host.import luxc/lang/translation/js/StructureValue
- (getValue [] (Array Object)))
+(host.import luxc/lang/translation/js/StructureValue)
(def: (js-structure value)
(-> (Array Object) JSObject)
@@ -255,125 +303,6 @@
## (lux-obj object)
## obj))
-(def: (int js-object)
- (-> ScriptObjectMirror (Maybe Int))
- (case [(JSObject::getMember [int-high-field] js-object)
- (JSObject::getMember [int-low-field] js-object)]
- (^multi [(#.Some high) (#.Some low)]
- (and (host.instance? Number high)
- (host.instance? Number low))
- [[(Number::longValue [] (:! Number high))
- (Number::longValue [] (:! Number low))]
- [high low]])
- (#.Some (nat-to-int (n/+ (|> high (:! Int) int-to-nat (bit.shift-left +32))
- (|> low (:! Int) int-to-nat))))
-
- _
- #.None))
-
-(def: (extend-array by input)
- (All [a] (-> Nat (Array a) (Array a)))
- (let [size (array.size input)]
- (|> (array.new (n/+ by size))
- (array.copy size +0 input +0))))
-
-(def: (array element-parser js-object)
- (-> (-> Object (Error Top)) ScriptObjectMirror (Maybe (Array Object)))
- (if (JSObject::isArray [] js-object)
- (let [init-num-keys (int-to-nat (ScriptObjectMirror::size [] js-object))]
- (loop [num-keys init-num-keys
- idx +0
- output (: (Array Object)
- (array.new init-num-keys))]
- (if (n/< num-keys idx)
- (let [idx-key (|> idx nat-to-int %i)]
- (case (JSObject::getMember idx-key js-object)
- (#.Some member)
- (case (element-parser member)
- (#e.Success parsed-member)
- (recur num-keys
- (n/inc idx)
- (array.write idx (:! Object parsed-member) output))
-
- (#e.Error error)
- #.None)
-
- #.None
- (recur (n/inc num-keys)
- (n/inc idx)
- (extend-array +1 output))))
- (#.Some output))))
- #.None))
-
-(exception: #export Unknown-Kind-Of-JS-Object)
-(exception: #export Null-Has-No-Lux-Representation)
-
-(def: (lux-object js-object)
- (-> Object (Error Top))
- (`` (cond (host.null? js-object)
- (ex.throw Null-Has-No-Lux-Representation "")
-
- (host.instance? Integer js-object)
- (ex.return (Integer::longValue [] (:! Integer js-object)))
-
- (or (host.instance? java/lang/Boolean js-object)
- (host.instance? java/lang/String js-object))
- (ex.return js-object)
-
- (host.instance? Number js-object)
- (ex.return (Number::doubleValue [] (:! Number js-object)))
-
- (~~ (do-template [<interface> <method>]
- [(host.instance? <interface> js-object)
- (ex.return (<method> [] (:! <interface> js-object)))]
-
- [StructureValue StructureValue::getValue]
- [IntValue IntValue::getValue]))
-
- (host.instance? ScriptObjectMirror js-object)
- (let [js-object (:! ScriptObjectMirror js-object)]
- (case (int js-object)
- (#.Some value)
- (ex.return value)
-
- #.None
- (case (array lux-object js-object)
- (#.Some value)
- (ex.return value)
-
- #.None
- ## (JSObject::isFunction [] js-object)
- ## js-object
-
- ## else
- (ex.throw Unknown-Kind-Of-JS-Object (Object::toString [] (:! Object js-object))))))
-
- ## else
- (ex.throw Unknown-Kind-Of-JS-Object (Object::toString [] (:! Object js-object))))))
-
-(def: #export (eval code)
- (-> Expression (Meta Top))
- (function [compiler]
- (case (|> compiler
- (:! Host)
- (get@ #interpreter)
- (ScriptEngine::eval [code]))
- (#e.Error error)
- ((lang.fail (Cannot-Evaluate error)) compiler)
-
- (#e.Success output)
- (case output
- #.None
- (#e.Success [compiler []])
-
- (#.Some output)
- (case (lux-object output)
- (#e.Success parsed-output)
- (#e.Success [compiler parsed-output])
-
- (#e.Error error)
- (#e.Error error))))))
-
(def: #export unit Text "\u0000")
(def: (module-name module)
@@ -382,17 +311,20 @@
(text.replace-all "/" "$")
(text.replace-all "-" "_")))
-(def: (definition-name [module name])
+(def: #export (definition-name [module name])
(-> Ident Text)
(format (module-name module) "$" (lang.normalize-name name)))
+(def: #export (save-js code)
+ (-> JS (Meta Unit))
+ (do macro.Monad<Meta>
+ [module-buffer module-buffer
+ #let [_ (AbstractStringBuilder::append [code] module-buffer)]]
+ (execute code)))
+
(def: #export (save-definition name code)
(-> Ident Expression (Meta Unit))
- (do macro.Monad<Meta>
- [#let [js-definition (format "var " (definition-name name) " = " code ";\n")]
- module-buffer module-buffer
- #let [_ (AbstractStringBuilder::append [js-definition] module-buffer)]]
- (execute js-definition)))
+ (save-js (format "var " (definition-name name) " = " code ";\n")))
(def: #export (save-module! target)
(-> File (Meta (Process Unit)))
diff --git a/new-luxc/source/luxc/lang/translation/js/case.jvm.lux b/new-luxc/source/luxc/lang/translation/js/case.jvm.lux
index a005a45a1..626181984 100644
--- a/new-luxc/source/luxc/lang/translation/js/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/case.jvm.lux
@@ -1,9 +1,12 @@
(.module:
lux
- (lux (control [monad #+ do])
+ (lux (control [monad #+ do]
+ ["ex" exception #+ exception:])
(data text/format
- (coll [list "list/" Fold<List>])))
- (luxc (lang ["ls" synthesis]))
+ (coll [list "list/" Fold<List>]))
+ [macro #+ "meta/" Monad<Meta>])
+ (luxc [lang]
+ (lang ["ls" synthesis]))
[//]
(// [".T" runtime]
[".T" primitive]
@@ -25,20 +28,16 @@
(Meta //.Expression))
(do macro.Monad<Meta>
[valueJS (translate valueS)]
- (wrap (list/fold (function [source [idx tail?]]
+ (wrap (list/fold (function [[idx tail?] source]
(let [method (if tail? runtimeT.product//right runtimeT.product//left)]
- (format method "(" source "," idx ")")))
+ (format method "(" source "," (|> idx nat-to-int %i) ")")))
(format "(" valueJS ")")
path))))
-(def: #export (translate-if translate testS thenS elseS)
- (-> (-> ls.Synthesis (Meta //.Expression)) ls.Synthesis ls.Synthesis ls.Synthesis
- (Meta //.Expression))
- (do macro.Monad<Meta>
- [testJS (translate testS)
- thenJS (translate thenS)
- elseJS (translate elseS)]
- (wrap (format "(" testJS " ? " thenJS " : " elseJS ")"))))
+(def: #export (translate-if testJS thenJS elseJS)
+ (-> //.Expression //.Expression //.Expression
+ //.Expression)
+ (format "(" testJS " ? " thenJS " : " elseJS ")"))
(def: savepoint
//.Expression
@@ -76,6 +75,8 @@
//.Statement
(format "throw " pm-error ";"))
+(exception: #export Unrecognized-Path)
+
(def: (translate-pattern-matching' translate path)
(-> (-> ls.Synthesis (Meta //.Expression)) Code (Meta //.Expression))
(case path
@@ -85,10 +86,10 @@
(wrap (format "return " bodyJS ";")))
(^code ("lux case pop"))
- (wrap pop-cursor)
+ (meta/wrap pop-cursor)
(^code ("lux case bind" (~ [_ (#.Nat register)])))
- (wrap (format "var " (referenceT.variable register) " = " peek-cursor ";"))
+ (meta/wrap (format "var " (referenceT.variable register) " = " peek-cursor ";"))
(^template [<tag> <translate>]
[_ (<tag> value)]
@@ -100,27 +101,27 @@
[#.Deg primitiveT.translate-deg])
(^template [<tag> <format>]
- (<tag> value)
- (wrap (format "if(" peek-cursor " !== " (<format> value) ") { " fail-pattern-matching " }")))
+ [_ (<tag> value)]
+ (meta/wrap (format "if(" peek-cursor " !== " (<format> value) ") { " fail-pattern-matching " }")))
([#.Bool %b]
[#.Frac %f]
[#.Text %t])
(^template [<pm> <getter>]
(^code (<pm> (~ [_ (#.Nat idx)])))
- (wrap (push-cursor (format <getter> "(" peek-cursor "," (|> idx nat-to-int %i) ")"))))
+ (meta/wrap (push-cursor (format <getter> "(" peek-cursor "," (|> idx nat-to-int %i) ")"))))
(["lux case tuple left" runtimeT.product//left]
["lux case tuple right" runtimeT.product//right])
(^template [<pm> <flag>]
(^code (<pm> (~ [_ (#.Nat idx)])))
- (wrap (format "temp = " runtimeT.sum//get "(" peek-cursor "," (|> idx nat-to-int %i) "," <flag> ");"
- "if(temp !== null) {"
- (push-cursor "temp")
- "}"
- "else {"
- fail-pattern-matching
- "}")))
+ (meta/wrap (format "temp = " runtimeT.sum//get "(" peek-cursor "," (|> idx nat-to-int %i) "," <flag> ");"
+ "if(temp !== null) {"
+ (push-cursor "temp")
+ "}"
+ "else {"
+ fail-pattern-matching
+ "}")))
(["lux case variant left" "null"]
["lux case variant right" "\"\""])
@@ -147,6 +148,9 @@
"throw ex;"
"}"
"}")))
+
+ _
+ (lang.throw Unrecognized-Path (%code path))
))
(def: report-pattern-matching-error
diff --git a/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux
new file mode 100644
index 000000000..bcf70bcae
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux
@@ -0,0 +1,164 @@
+(.module:
+ lux
+ (lux (control ["ex" exception #+ exception:])
+ (data [bit]
+ ["e" error #+ Error]
+ text/format
+ (coll [array]))
+ [host])
+ (luxc [lang])
+ [//])
+
+(host.import java/lang/Object
+ (toString [] String))
+
+(host.import java/lang/Number
+ (doubleValue [] double)
+ (longValue [] Long))
+
+(host.import java/lang/Integer
+ (longValue [] Long))
+
+(host.import javax/script/ScriptEngine
+ (eval [String] #try #? Object))
+
+(host.import jdk/nashorn/api/scripting/JSObject
+ (isArray [] boolean)
+ (isFunction [] boolean)
+ (getMember [String] #? Object)
+ (hasMember [String] boolean))
+
+(host.import jdk/nashorn/api/scripting/AbstractJSObject)
+
+(host.import jdk/nashorn/api/scripting/ScriptObjectMirror
+ (size [] int))
+
+(host.import jdk/nashorn/internal/runtime/Undefined)
+
+(host.import luxc/lang/translation/js/IntValue
+ (getValue [] Long))
+
+(host.import luxc/lang/translation/js/StructureValue
+ (getValue [] (Array Object)))
+
+(def: (int js-object)
+ (-> ScriptObjectMirror (Maybe Int))
+ (case [(JSObject::getMember [//.int-high-field] js-object)
+ (JSObject::getMember [//.int-low-field] js-object)]
+ (^multi [(#.Some high) (#.Some low)]
+ (and (host.instance? Number high)
+ (host.instance? Number low))
+ [[(Number::longValue [] (:! Number high))
+ (Number::longValue [] (:! Number low))]
+ [high low]])
+ (#.Some (nat-to-int (n/+ (|> high (:! Int) int-to-nat (bit.shift-left +32))
+ (|> low (:! Int) int-to-nat))))
+
+ _
+ #.None))
+
+(def: (extend-array by input)
+ (All [a] (-> Nat (Array a) (Array a)))
+ (let [size (array.size input)]
+ (|> (array.new (n/+ by size))
+ (array.copy size +0 input +0))))
+
+(def: (array element-parser js-object)
+ (-> (-> Object (Error Top)) ScriptObjectMirror (Maybe (Array Object)))
+ (if (JSObject::isArray [] js-object)
+ (let [init-num-keys (int-to-nat (ScriptObjectMirror::size [] js-object))]
+ (loop [num-keys init-num-keys
+ idx +0
+ output (: (Array Object)
+ (array.new init-num-keys))]
+ (if (n/< num-keys idx)
+ (let [idx-key (|> idx nat-to-int %i)]
+ (case (JSObject::getMember idx-key js-object)
+ (#.Some member)
+ (case (element-parser member)
+ (#e.Success parsed-member)
+ (recur num-keys
+ (n/inc idx)
+ (array.write idx (:! Object parsed-member) output))
+
+ (#e.Error error)
+ #.None)
+
+ #.None
+ (recur (n/inc num-keys)
+ (n/inc idx)
+ (extend-array +1 output))))
+ (#.Some output))))
+ #.None))
+
+(exception: #export Unknown-Kind-Of-JS-Object)
+(exception: #export Null-Has-No-Lux-Representation)
+
+(def: (lux-object js-object)
+ (-> Object (Error Top))
+ (`` (cond (host.null? js-object)
+ (ex.throw Null-Has-No-Lux-Representation "")
+
+ (host.instance? Integer js-object)
+ (ex.return (Integer::longValue [] (:! Integer js-object)))
+
+ (or (host.instance? java/lang/Boolean js-object)
+ (host.instance? java/lang/String js-object))
+ (ex.return js-object)
+
+ (host.instance? Number js-object)
+ (ex.return (Number::doubleValue [] (:! Number js-object)))
+
+ (~~ (do-template [<interface> <method>]
+ [(host.instance? <interface> js-object)
+ (ex.return (<method> [] (:! <interface> js-object)))]
+
+ [StructureValue StructureValue::getValue]
+ [IntValue IntValue::getValue]))
+
+ (host.instance? ScriptObjectMirror js-object)
+ (let [js-object (:! ScriptObjectMirror js-object)]
+ (case (int js-object)
+ (#.Some value)
+ (ex.return value)
+
+ #.None
+ (case (array lux-object js-object)
+ (#.Some value)
+ (ex.return value)
+
+ #.None
+ ## (JSObject::isFunction [] js-object)
+ ## js-object
+
+ ## else
+ (ex.throw Unknown-Kind-Of-JS-Object (Object::toString [] (:! Object js-object))))))
+
+ ## else
+ (ex.throw Unknown-Kind-Of-JS-Object (Object::toString [] (:! Object js-object))))))
+
+(exception: #export Cannot-Evaluate)
+
+(def: #export (eval code)
+ (-> //.Expression (Meta Top))
+ (function [compiler]
+ (case (|> compiler
+ (get@ #.host)
+ (:! //.Host)
+ (get@ #//.interpreter)
+ (ScriptEngine::eval [code]))
+ (#e.Error error)
+ ((lang.throw Cannot-Evaluate error) compiler)
+
+ (#e.Success output)
+ (case output
+ #.None
+ (#e.Success [compiler []])
+
+ (#.Some output)
+ (case (lux-object output)
+ (#e.Success parsed-output)
+ (#e.Success [compiler parsed-output])
+
+ (#e.Error error)
+ ((lang.throw Cannot-Evaluate error) compiler))))))
diff --git a/new-luxc/source/luxc/lang/translation/js/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/js/expression.jvm.lux
index a25013305..4634497a1 100644
--- a/new-luxc/source/luxc/lang/translation/js/expression.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/expression.jvm.lux
@@ -2,9 +2,15 @@
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:]
- ["p" parser]))
+ ["p" parser])
+ (data ["e" error]
+ text/format)
+ [macro]
+ (macro ["s" syntax]))
(luxc ["&" lang]
- (lang ["ls" synthesis]))
+ (lang [".L" variable #+ Variable Register]
+ [".L" extension]
+ ["ls" synthesis]))
[//]
(// [".T" runtime]
[".T" primitive]
@@ -12,15 +18,17 @@
[".T" reference]
[".T" function]
[".T" loop]
- [".T" case]))
+ [".T" case]
+ [".T" procedure]))
+(exception: #export Invalid-Function-Syntax)
(exception: #export Unrecognized-Synthesis)
(def: #export (translate synthesis)
(-> ls.Synthesis (Meta //.Expression))
(case synthesis
(^code [])
- (wrap runtimeT.unit)
+ (:: macro.Monad<Meta> wrap runtimeT.unit)
(^code [(~ singleton)])
(translate singleton)
@@ -42,22 +50,24 @@
(structureT.translate-tuple translate members)
(^ [_ (#.Form (list [_ (#.Int var)]))])
- (if (variableL.captured? var)
- (referenceT.translate-captured var)
- (referenceT.translate-local var))
+ (referenceT.translate-variable var)
[_ (#.Symbol definition)]
(referenceT.translate-definition definition)
(^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS)))
- (caseT.translate-let translate register inputS exprS)
+ (caseT.translate-let translate inputS register exprS)
(^code ("lux case" (~ inputS) (~ pathPS)))
(caseT.translate-case translate inputS pathPS)
- (^multi (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
- [(s.run environment (p.some s.int)) (#e.Success environment)])
- (functionT.translate-function translate environment arity bodyS)
+ (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
+ (case (s.run environment (p.some s.int))
+ (#e.Success environment)
+ (functionT.translate-function translate environment arity bodyS)
+
+ _
+ (&.throw Invalid-Function-Syntax (%code synthesis)))
(^code ("lux call" (~ functionS) (~+ argsS)))
(functionT.translate-apply translate functionS argsS)
diff --git a/new-luxc/source/luxc/lang/translation/js/function.jvm.lux b/new-luxc/source/luxc/lang/translation/js/function.jvm.lux
index 4debb077b..b0865a16e 100644
--- a/new-luxc/source/luxc/lang/translation/js/function.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/function.jvm.lux
@@ -40,22 +40,23 @@
(List Variable) ls.Arity ls.Synthesis
(Meta //.Expression))
(do macro.Monad<Meta>
- [[function-name bodyJS] (hostL.with-sub-context
- (translate bodyS))
- closureJS+ (monad.map @ translate env)
+ [[function-name bodyJS] (//.with-sub-context
+ (do @
+ [function-name //.context]
+ (//.with-anchor [function-name +1]
+ (translate bodyS))))
+ closureJS+ (monad.map @ referenceT.translate-variable env)
#let [args-initsJS+ (|> (list.n/range +0 (n/dec arity))
(list/map input-declaration)
(text.join-with ""))
selfJS (format "var " (referenceT.variable +0) " = " function-name ";")
- loop-startJs (format "var " loopT.loop-name " = " function-name ";")
arityJS (|> arity nat-to-int %i)]]
(wrap (<| (with-closure closureJS+)
(format "(function " function-name "() {"
"\"use strict\";"
"var num_args = arguments.length;"
- "if(num_args == " arity ") {"
+ "if(num_args == " arityJS ") {"
selfJS
- loop-startJs
args-initsJS+
(format "while(true) {"
"return " bodyJS ";"
diff --git a/new-luxc/source/luxc/lang/translation/js/imports.jvm.lux b/new-luxc/source/luxc/lang/translation/js/imports.jvm.lux
new file mode 100644
index 000000000..725aff705
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/js/imports.jvm.lux
@@ -0,0 +1,64 @@
+(.module:
+ lux
+ (lux (control [monad #+ do]
+ ["p" parser]
+ ["ex" exception #+ exception:])
+ (data ["e" error #+ Error]
+ [maybe]
+ [text "text/" Eq<Text>]
+ text/format)
+ [macro]
+ (macro [code]
+ ["s" syntax])
+ [io #+ Process])
+ (luxc [lang]
+ (lang [".L" module])))
+
+(exception: #export Invalid-Imports)
+(exception: #export Module-Cannot-Import-Itself)
+(exception: #export Circular-Dependency)
+
+(type: Import
+ {#module Text
+ #alias Text})
+
+(def: import (s.Syntax Import) (s.tuple (p.seq s.text s.text)))
+
+(def: #export (translate-imports translate-module annotations)
+ (-> (-> Text Compiler (Process Compiler))
+ Code
+ (Meta (Process Compiler)))
+ (do macro.Monad<Meta>
+ [_ (moduleL.set-annotations annotations)
+ current-module macro.current-module-name
+ imports (let [imports (|> (macro.get-tuple-ann (ident-for #.imports) annotations)
+ (maybe.default (list)))]
+ (case (s.run imports (p.some import))
+ (#e.Success imports)
+ (wrap imports)
+
+ (#e.Error error)
+ (lang.throw Invalid-Imports (%code (code.tuple imports)))))
+ _ (monad.map @ (function [[dependency alias]]
+ (do @
+ [_ (lang.assert Module-Cannot-Import-Itself current-module
+ (not (text/= current-module dependency)))
+ already-seen? (moduleL.exists? dependency)
+ circular-dependency? (if already-seen?
+ (moduleL.active? dependency)
+ (wrap false))
+ _ (lang.assert Circular-Dependency (format "From: " current-module "\n"
+ " To: " dependency)
+ (not circular-dependency?))
+ _ (moduleL.import dependency)
+ _ (if (text/= "" alias)
+ (wrap [])
+ (moduleL.alias alias dependency))]
+ (wrap [])))
+ imports)
+ compiler macro.get-compiler]
+ (wrap (monad.fold io.Monad<Process>
+ (function [import]
+ (translate-module (get@ #module import)))
+ compiler
+ imports))))
diff --git a/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux
index 64b2e5b39..9315508e8 100644
--- a/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux
@@ -5,27 +5,30 @@
text/format
(coll [list "list/" Functor<List>]))
[macro])
- (luxc (lang ["ls" synthesis]))
+ (luxc [lang]
+ (lang ["ls" synthesis]))
[//]
(// [".T" reference]))
-(def: #export loop-name Text "_loop")
-
(def: #export (translate-loop translate offset initsS+ bodyS)
(-> (-> ls.Synthesis (Meta //.Expression)) Nat (List ls.Synthesis) ls.Synthesis
(Meta //.Expression))
(do macro.Monad<Meta>
- [initsJS+ (monad.map @ translate initsS+)
- bodyJS (translate bodyS)
+ [loop-name (:: @ map (|>> %code lang.normalize-name)
+ (macro.gensym "loop"))
+ initsJS+ (monad.map @ translate initsS+)
+ bodyJS (//.with-anchor [loop-name offset]
+ (translate bodyS))
#let [registersJS+ (|> (list.n/range +0 (n/dec (list.size initsS+)))
(list/map (|>> (n/+ offset) referenceT.variable)))]]
(wrap (format "(function " loop-name "(" (text.join-with "," registersJS+) ") {"
"return " bodyJS ";"
"})(" (text.join-with "," initsJS+) ")"))))
-(def: #export (translate-iter translate offset argsS+)
- (-> (-> ls.Synthesis (Meta //.Expression)) Nat (List ls.Synthesis)
+(def: #export (translate-recur translate argsS+)
+ (-> (-> ls.Synthesis (Meta //.Expression)) (List ls.Synthesis)
(Meta //.Expression))
(do macro.Monad<Meta>
- [argsJS+ (monad.map @ translate argsS+)]
+ [[loop-name offset] //.anchor
+ argsJS+ (monad.map @ translate argsS+)]
(wrap (format loop-name "(" (text.join-with "," argsJS+) ")"))))
diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
index b0dbe4533..445aa6f00 100644
--- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
@@ -1,6 +1,8 @@
(.module:
lux
- (lux (control [monad #+ do])
+ (lux (control [monad #+ do]
+ ["ex" exception #+ exception:]
+ ["p" parser])
(data ["e" error]
[text]
text/format
@@ -8,7 +10,8 @@
[dict #+ Dict]))
[macro #+ with-gensyms]
(macro [code]
- ["s" syntax #+ syntax:]))
+ ["s" syntax #+ syntax:])
+ [host])
(luxc ["&" lang]
(lang ["la" analysis]
["ls" synthesis]))
@@ -91,11 +94,11 @@
(wrap (proc inputsI))))))
(def: (self-contained content)
- (-> //.Expression //.Expression)
+ (-> ///.Expression ///.Expression)
(format "(" content ")"))
(def: (void action)
- (-> //.Expression //.Expression)
+ (-> ///.Expression ///.Expression)
(format "(" action "," runtimeT.unit ")"))
## [Procedures]
@@ -150,8 +153,8 @@
[bit//or runtimeT.bit//or]
[bit//xor runtimeT.bit//xor]
[bit//shift-left runtimeT.bit//shift-left]
- [bit//shift-right runtimeT.bit//shift-right]
- [bit//unsigned-shift-right runtimeT.bit//unsigned-shift-right]
+ [bit//shift-right runtimeT.bit//signed-shift-right]
+ [bit//unsigned-shift-right runtimeT.bit//shift-right]
)
(def: (bit//count subjectJS)
@@ -180,26 +183,37 @@
(format arrayJS ".length"))
## [[Numbers]]
-(do-template [<name> <encode> <type>]
+(host.import java/lang/Long
+ (#static MIN_VALUE Long)
+ (#static MAX_VALUE Long))
+
+(host.import java/lang/Double
+ (#static MIN_VALUE Double)
+ (#static MAX_VALUE Double)
+ (#static NaN Double)
+ (#static POSITIVE_INFINITY Double)
+ (#static NEGATIVE_INFINITY Double))
+
+(do-template [<name> <const> <encode>]
[(def: (<name> _)
Nullary
(<encode> <const>))]
- [nat//min 0 js-int]
- [nat//max -1 js-int]
+ [nat//min 0 runtimeT.int-constant]
+ [nat//max -1 runtimeT.int-constant]
- [int//min Long::MIN_VALUE js-int]
- [int//max Long::MAX_VALUE js-int]
+ [int//min Long::MIN_VALUE runtimeT.int-constant]
+ [int//max Long::MAX_VALUE runtimeT.int-constant]
- [frac//smallest Double::MIN_VALUE js-frac]
- [frac//min (f/* -1.0 Double::MAX_VALUE) js-frac]
- [frac//max Double::MAX_VALUE js-frac]
- [frac//not-a-number Double::NaN js-frac]
- [frac//positive-infinity Double::POSITIVE_INFINITY js-frac]
- [frac//negative-infinity Double::NEGATIVE_INFINITY js-frac]
-
- [deg//min 0 js-int]
- [deg//max -1 js-int]
+ [frac//smallest Double::MIN_VALUE runtimeT.frac-constant]
+ [frac//min (f/* -1.0 Double::MAX_VALUE) runtimeT.frac-constant]
+ [frac//max Double::MAX_VALUE runtimeT.frac-constant]
+ [frac//not-a-number Double::NaN runtimeT.frac-constant]
+ [frac//positive-infinity Double::POSITIVE_INFINITY runtimeT.frac-constant]
+ [frac//negative-infinity Double::NEGATIVE_INFINITY runtimeT.frac-constant]
+
+ [deg//min 0 runtimeT.int-constant]
+ [deg//max -1 runtimeT.int-constant]
)
(do-template [<name> <op>]
@@ -238,9 +252,10 @@
[frac//mul "*"]
[frac//div "/"]
[frac//rem "%"]
- [frac//= "=="]
+ [frac//= "==="]
[frac//< "<"]
- [text//= "=="]
+
+ [text//= "==="]
[text//< "<"]
)
@@ -277,7 +292,7 @@
(do-template [<name> <transform>]
[(def: (<name> inputJS)
Unary
- (<transform> "(" inputJS ")"))]
+ (format <transform> "(" inputJS ")"))]
[int//to-frac runtimeT.int//to-number]
[frac//to-int runtimeT.int//from-number]
@@ -326,7 +341,7 @@
(def: (text//replace-once [subjectJS paramJS extraJS])
Trinary
- (format subjectJS "." <method> "(" paramJS "," extraJS ")"))
+ (format subjectJS ".replace(" paramJS "," extraJS ")"))
(do-template [<name> <method>]
[(def: (<name> [textJS partJS startJS])
@@ -398,7 +413,7 @@
(def: (atom//compare-and-swap [atomJS oldJS newJS])
Trinary
- (format atom//compare-and-swap "(" atomJS "," oldJS "," newJS ")"))
+ (format runtimeT.atom//compare-and-swap "(" atomJS "," oldJS "," newJS ")"))
## [[Box]]
(def: (box//new initJS)
@@ -407,7 +422,7 @@
(def: (box//read boxJS)
Unary
- (format "[" boxJS "][0]"))
+ (format "(" boxJS ")[0]"))
(def: (box//write [valueJS boxJS])
Binary
@@ -464,8 +479,8 @@
(install "*" (binary nat//mul))
(install "/" (binary nat//div))
(install "%" (binary nat//rem))
- (install "=" (binary nat//eq))
- (install "<" (binary nat//lt))
+ (install "=" (binary nat//=))
+ (install "<" (binary nat//<))
(install "min" (nullary nat//min))
(install "max" (nullary nat//max))
(install "to-int" (unary nat//to-int))
@@ -480,8 +495,8 @@
(install "*" (binary int//mul))
(install "/" (binary int//div))
(install "%" (binary int//rem))
- (install "=" (binary int//eq))
- (install "<" (binary int//lt))
+ (install "=" (binary int//=))
+ (install "<" (binary int//<))
(install "min" (nullary int//min))
(install "max" (nullary int//max))
(install "to-nat" (unary int//to-nat))
@@ -496,8 +511,8 @@
(install "*" (binary deg//mul))
(install "/" (binary deg//div))
(install "%" (binary deg//rem))
- (install "=" (binary deg//eq))
- (install "<" (binary deg//lt))
+ (install "=" (binary deg//=))
+ (install "<" (binary deg//<))
(install "scale" (binary deg//scale))
(install "reciprocal" (binary deg//reciprocal))
(install "min" (nullary deg//min))
@@ -513,8 +528,8 @@
(install "*" (binary frac//mul))
(install "/" (binary frac//div))
(install "%" (binary frac//rem))
- (install "=" (binary frac//eq))
- (install "<" (binary frac//lt))
+ (install "=" (binary frac//=))
+ (install "<" (binary frac//<))
(install "smallest" (nullary frac//smallest))
(install "min" (nullary frac//min))
(install "max" (nullary frac//max))
@@ -530,8 +545,8 @@
Bundle
(<| (prefix "text")
(|> (dict.new text.Hash<Text>)
- (install "=" (binary text//eq))
- (install "<" (binary text//lt))
+ (install "=" (binary text//=))
+ (install "<" (binary text//<))
(install "concat" (binary text//concat))
(install "index" (trinary text//index))
(install "size" (unary text//size))
@@ -616,8 +631,7 @@
(def: #export procedures
Bundle
(<| (prefix "lux")
- (|> (dict.new text.Hash<Text>)
- (dict.merge lux-procs)
+ (|> lux-procs
(dict.merge bit-procs)
(dict.merge nat-procs)
(dict.merge int-procs)
diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux
index 4ac0d2022..7fe3f545c 100644
--- a/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux
@@ -118,7 +118,7 @@
(format runtimeT.array//get "(" arrayJS "," indexJS ")"))
(def: (array//write [indexJS valueJS arrayJS])
- @.Binary
+ @.Trinary
(format runtimeT.array//put "(" arrayJS "," indexJS "," valueJS ")"))
(def: (array//delete [indexJS arrayJS])
@@ -133,17 +133,17 @@
@.Bundle
(<| (@.prefix "array")
(|> (dict.new text.Hash<Text>)
- (@.install "literal" array//literal)
- (@.install "read" array//read)
- (@.install "write" array//write)
- (@.install "delete" array//delete)
- (@.install "length" array//length)
+ (@.install "literal" (@.variadic array//literal))
+ (@.install "read" (@.binary array//read))
+ (@.install "write" (@.trinary array//write))
+ (@.install "delete" (@.binary array//delete))
+ (@.install "length" (@.unary array//length))
)))
(def: #export procedures
@.Bundle
(<| (@.prefix "js")
- (|> (dict.merge js-procs)
+ (|> js-procs
(dict.merge object-procs)
(dict.merge array-procs)
)))
diff --git a/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux
index 33cf3ed7d..66d340949 100644
--- a/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux
@@ -3,25 +3,32 @@
(lux [macro]
(data [text]
text/format))
- (luxc ["&" lang])
+ (luxc ["&" lang]
+ (lang [".L" variable #+ Variable Register]))
[//]
(// [".T" runtime]))
(do-template [<register> <translation> <prefix>]
[(def: #export (<register> register)
- (-> Nat //.Expression)
+ (-> Register //.Expression)
(format <prefix> (%n register)))
(def: #export (<translation> register)
- (-> Nat (Meta //.Expression))
+ (-> Register (Meta //.Expression))
(:: macro.Monad<Meta> wrap (<register> register)))]
- [closure translate-local "c"]
- [variable translate-captured "v"])
+ [closure translate-captured "c"]
+ [variable translate-local "v"])
-(def: #export (global [module name])
+(def: #export (translate-variable var)
+ (-> Variable (Meta //.Expression))
+ (if (variableL.captured? var)
+ (translate-captured (int-to-nat var))
+ (translate-local (int-to-nat var))))
+
+(def: #export global
(-> Ident //.Expression)
- (format (text.replace-all "/" "_" module) "$" (&.normalize-name name)))
+ //.definition-name)
(def: #export (translate-definition name)
(-> Ident (Meta //.Expression))
diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
index 4c50a7aef..e9653547d 100644
--- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
@@ -1,8 +1,11 @@
(.module:
lux
- (lux (data text/format)
+ (lux (control [monad #+ do])
+ (data text/format)
+ [macro]
(macro [code]
- ["s" syntax #+ syntax:]))
+ ["s" syntax #+ syntax:])
+ [io #+ Process])
[//])
(def: prefix Text "LuxRuntime")
@@ -56,6 +59,18 @@
(function [(~' @)]
<js-definition>)))))
+(def: #export (int-constant value)
+ (-> Int //.Expression)
+ (format "{"
+ //.int-high-field " : " (|> value int-to-nat //.high nat-to-int %i)
+ ", "
+ //.int-low-field " : " (|> value int-to-nat //.low nat-to-int %i)
+ "}"))
+
+(def: #export (frac-constant value)
+ (-> Frac //.Expression)
+ (%f value))
+
(runtime: lux//try "runTry"
(format "(function " @ "(op) {"
(format "try {"
@@ -1109,6 +1124,8 @@
(def: #export artifact Text (format prefix ".js"))
-## (def: #export generate
-## (Meta Unit)
-## (&&/save-js! artifact runtime))
+(def: #export translate
+ (Meta (Process Unit))
+ (do macro.Monad<Meta>
+ [_ (//.save-js runtime)]
+ (//.save-module! artifact)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux
index a4eb5b93b..c78b0baeb 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux
@@ -42,11 +42,11 @@
(type: #export Artifacts (Dict File Blob))
(type: #export Host
- {#loader ClassLoader
+ {#context [Text Nat]
+ #anchor (Maybe [Label Register])
+ #loader ClassLoader
#store Class-Store
- #artifacts Artifacts
- #context [Text Nat]
- #anchor (Maybe [Label Register])})
+ #artifacts Artifacts})
(exception: #export Unknown-Class)
(exception: #export Class-Already-Stored)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux
index 82c8c0ec0..67a6935ba 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux
@@ -21,6 +21,7 @@
[".T" case]
[".T" procedure]))
+(exception: #export Invalid-Function-Syntax)
(exception: #export Unrecognized-Synthesis)
(def: #export (translate synthesis)
@@ -62,9 +63,13 @@
(^code ("lux case" (~ inputS) (~ pathPS)))
(caseT.translate-case translate inputS pathPS)
- (^multi (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
- [(s.run environment (p.some s.int)) (#e.Success environment)])
- (functionT.translate-function translate environment arity bodyS)
+ (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
+ (case (s.run environment (p.some s.int))
+ (#e.Success environment)
+ (functionT.translate-function translate environment arity bodyS)
+
+ _
+ (&.throw Invalid-Function-Syntax (%code synthesis)))
(^code ("lux call" (~ functionS) (~+ argsS)))
(functionT.translate-call translate functionS argsS)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
index c7513fd6e..57455e1e1 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -792,8 +792,7 @@
(def: #export procedures
Bundle
(<| (prefix "lux")
- (|> (dict.new text.Hash<Text>)
- (dict.merge lux-procs)
+ (|> lux-procs
(dict.merge bit-procs)
(dict.merge nat-procs)
(dict.merge int-procs)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux
index 30d17cac3..f585fb10c 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux
@@ -748,8 +748,7 @@
(def: #export procedures
@.Bundle
(<| (@.prefix "jvm")
- (|> (dict.new text.Hash<Text>)
- (dict.merge conversion-procs)
+ (|> conversion-procs
(dict.merge int-procs)
(dict.merge long-procs)
(dict.merge float-procs)