diff options
Diffstat (limited to '')
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) |