aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--commands.md96
-rw-r--r--lux-js/source/program.lux206
-rw-r--r--lux-jvm/source/program.lux50
-rw-r--r--stdlib/source/lux/macro.lux13
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux227
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux19
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux226
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux19
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux11
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux128
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux115
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/js.lux36
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/script.lux106
-rw-r--r--stdlib/source/program/compositor/cli.lux36
-rw-r--r--stdlib/source/test/lux.lux286
15 files changed, 850 insertions, 724 deletions
diff --git a/commands.md b/commands.md
index 7068c73d6..a1f3aea00 100644
--- a/commands.md
+++ b/commands.md
@@ -113,6 +113,55 @@ cd ~/lux/stdlib/ && java -jar target/program.jar --input ../license.json --outpu
---
+# JVM compiler
+
+## Test
+
+```
+cd ~/lux/lux-jvm/ && lein lux auto test
+cd ~/lux/lux-jvm/ && lein clean && lein lux auto test
+```
+
+## Build
+
+```
+cd ~/lux/lux-jvm/ && lein lux auto build
+cd ~/lux/lux-jvm/ && lein clean && lein lux auto build
+```
+
+## REPL
+
+```
+cd ~/lux/lux-jvm/ && java -jar target/program.jar repl --source ~/lux/stdlib/source --target ~/lux/stdlib/target
+```
+
+## Try
+
+```
+cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux
+cd ~/lux/stdlib/ && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux
+cd ~/lux/stdlib/ && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --library ~/lux/stdlib/target/library.tar --target ~/lux/stdlib/target --module test/lux
+cd ~/lux/lux-jvm/ && java -jar target/program.jar export --source ~/lux/stdlib/source --target ~/lux/stdlib/target
+
+cd ~/lux/stdlib/target/ && java -jar program.jar
+```
+
+## Deploy
+
+```
+cd ~/lux/lux-jvm/ && mvn install:install-file -Dfile=target/program.jar -DgroupId=com.github.luxlang -DartifactId=lux-jvm -Dversion=0.6.0-SNAPSHOT -Dpackaging=jar
+
+cd ~/lux/lux-jvm/ && mvn deploy:deploy-file \
+-Durl=https://<username>:<password>@oss.sonatype.org/content/repositories/snapshots/ \
+-Dfile=target/program.jar \
+-DgroupId=com.github.luxlang \
+-DartifactId=lux-jvm \
+-Dversion=0.6.0-SNAPSHOT \
+-Dpackaging=jar
+```
+
+---
+
# JavaScript compiler
## Test
@@ -314,52 +363,7 @@ cd ~/lux/lux-r/ && java -jar target/program.jar export --source ~/lux/stdlib/sou
cd ~/lux/stdlib/target/ && java -jar program.jar
```
-# JVM compiler
-
-## Test
-
-```
-cd ~/lux/lux-jvm/ && lein lux auto test
-cd ~/lux/lux-jvm/ && lein clean && lein lux auto test
-```
-
-## Build
-
-```
-cd ~/lux/lux-jvm/ && lein lux auto build
-cd ~/lux/lux-jvm/ && lein clean && lein lux auto build
-```
-
-## REPL
-
-```
-cd ~/lux/lux-jvm/ && java -jar target/program.jar repl --source ~/lux/stdlib/source --target ~/lux/stdlib/target
-```
-
-## Try
-
-```
-cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux
-cd ~/lux/stdlib/ && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux
-cd ~/lux/stdlib/ && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --library ~/lux/stdlib/target/library.tar --target ~/lux/stdlib/target --module test/lux
-cd ~/lux/lux-jvm/ && java -jar target/program.jar export --source ~/lux/stdlib/source --target ~/lux/stdlib/target
-
-cd ~/lux/stdlib/target/ && java -jar program.jar
-```
-
-## Deploy
-
-```
-cd ~/lux/lux-jvm/ && mvn install:install-file -Dfile=target/program.jar -DgroupId=com.github.luxlang -DartifactId=lux-jvm -Dversion=0.6.0-SNAPSHOT -Dpackaging=jar
-
-cd ~/lux/lux-jvm/ && mvn deploy:deploy-file \
--Durl=https://<username>:<password>@oss.sonatype.org/content/repositories/snapshots/ \
--Dfile=target/program.jar \
--DgroupId=com.github.luxlang \
--DartifactId=lux-jvm \
--Dversion=0.6.0-SNAPSHOT \
--Dpackaging=jar
-```
+---
# Compiler trial
diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux
index f3b149e72..cebede1ab 100644
--- a/lux-js/source/program.lux
+++ b/lux-js/source/program.lux
@@ -5,17 +5,22 @@
[abstract
[monad (#+ do)]]
[control
+ ["." try (#+ Try)]
["." exception (#+ exception:)]
["." io (#+ IO io)]
[parser
- [cli (#+ program:)]]]
+ [cli (#+ program:)]]
+ [concurrency
+ ["." promise (#+ Promise)]]]
[data
["." maybe]
- ["." error (#+ Error)]
[number
- ["." i64]]
- ["." text ("#@." hash)
- format]
+ ["." i64]
+ ["n" nat]
+ ["i" int]]
+ [text
+ ["%" format (#+ format)]
+ ["." encoding]]
[collection
["." array (#+ Array)]]]
[macro
@@ -26,22 +31,33 @@
["_" js]]
[tool
[compiler
- ["." name]
- [phase
- [macro (#+ Expander)]
- ["." extension #_
- ["#/." bundle]
- ["." analysis #_
- ["#/." js]]]
- ["." generation
- ["." js
- ["." runtime]
- ["." extension]]]]
+ [phase (#+ Operation Phase)]
+ [language
+ [lux
+ [program (#+ Program)]
+ [generation (#+ Context Host)]
+ [analysis
+ [macro (#+ Expander)]]
+ [phase
+ ["." extension (#+ Extender Handler)
+ ["#/." bundle]
+ ["." analysis #_
+ ["#" js]]
+ ["." generation #_
+ ["#" js]]]
+ [generation
+ ["." reference]
+ ["." js
+ ["." runtime]]]]]]
[default
- ["." platform (#+ Platform)]]]]]
+ ["." platform (#+ Platform)]]
+ [meta
+ ["." packager #_
+ ["#" script]]]]]]
[program
["/" compositor
- ["/." cli]]])
+ ["/." cli]
+ ["/." static]]])
(import: #long java/lang/String)
@@ -247,8 +263,8 @@
[[(java/lang/Number::longValue high)
(java/lang/Number::longValue low)]
[high low]])
- (#.Some (.int (n/+ (|> high .nat (i64.left-shift 32))
- (if (i/< +0 (.int low))
+ (#.Some (.int (n.+ (|> high .nat (i64.left-shift 32))
+ (if (i.< +0 (.int low))
(|> low .nat (i64.left-shift 32) (i64.logic-right-shift 32))
(.nat low)))))
@@ -256,7 +272,7 @@
#.None))
(def: (check-variant lux-object js-object)
- (-> (-> java/lang/Object (Error Any))
+ (-> (-> java/lang/Object (Try Any))
jdk/nashorn/api/scripting/ScriptObjectMirror
(Maybe Any))
(case [(jdk/nashorn/api/scripting/JSObject::getMember [runtime.variant-tag-field] js-object)
@@ -275,7 +291,7 @@
#.None))
(def: (check-array lux-object js-object)
- (-> (-> java/lang/Object (Error Any))
+ (-> (-> java/lang/Object (Try Any))
jdk/nashorn/api/scripting/ScriptObjectMirror
(Maybe (Array java/lang/Object)))
(if (jdk/nashorn/api/scripting/JSObject::isArray js-object)
@@ -283,8 +299,8 @@
(loop [idx 0
output (: (Array java/lang/Object)
(array.new num-keys))]
- (if (n/< num-keys idx)
- (case (jdk/nashorn/api/scripting/JSObject::getMember (%n idx) js-object)
+ (if (n.< num-keys idx)
+ (case (jdk/nashorn/api/scripting/JSObject::getMember (%.nat idx) js-object)
(#.Some member)
(case (host.check jdk/nashorn/internal/runtime/Undefined member)
(#.Some _)
@@ -292,10 +308,10 @@
#.None
(case (lux-object member)
- (#error.Success parsed-member)
+ (#try.Success parsed-member)
(recur (inc idx) (array.write idx (:coerce java/lang/Object parsed-member) output))
- (#error.Failure error)
+ (#try.Failure error)
#.None))
#.None
@@ -304,12 +320,12 @@
#.None))
(def: (lux-object js-object)
- (-> java/lang/Object (Error Any))
+ (-> java/lang/Object (Try Any))
(`` (<| (if (host.null? js-object)
- (exception.throw null-has-no-lux-representation []))
+ (exception.throw ..null-has-no-lux-representation []))
(case (host.check jdk/nashorn/internal/runtime/Undefined js-object)
(#.Some _)
- (exception.throw undefined-has-no-lux-representation [])
+ (exception.throw ..undefined-has-no-lux-representation [])
#.None)
(~~ (template [<class>]
[(case (host.check <class> js-object)
@@ -362,10 +378,10 @@
#.None))))
(def: (call-macro inputs lux macro)
- (-> (List Code) Lux jdk/nashorn/api/scripting/JSObject (Error (Error [Lux (List Code)])))
+ (-> (List Code) Lux jdk/nashorn/api/scripting/JSObject (Try (Try [Lux (List Code)])))
(let [to-js (: (-> Any java/lang/Object)
(|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))]
- (<| (:coerce (Error (Error [Lux (List Code)])))
+ (<| (:coerce (Try (Try [Lux (List Code)])))
(jdk/nashorn/api/scripting/JSObject::call #.None
(|> (array.new 2)
(: (Array java/lang/Object))
@@ -378,77 +394,79 @@
(case (ensure-macro macro)
(#.Some macro)
(case (call-macro inputs lux macro)
- (#error.Success output)
+ (#try.Success output)
(|> output
(:coerce java/lang/Object)
lux-object
- (:coerce (Error (Error [Lux (List Code)]))))
+ (:coerce (Try (Try [Lux (List Code)]))))
- (#error.Failure error)
- (#error.Failure error))
+ (#try.Failure error)
+ (#try.Failure error))
#.None
- (exception.throw cannot-apply-a-non-function (:coerce java/lang/Object macro))))
-
-(def: separator "$")
+ (exception.throw ..cannot-apply-a-non-function (:coerce java/lang/Object macro))))
(def: (evaluate! interpreter alias input)
- (-> javax/script/ScriptEngine Text _.Expression (Error Any))
- (do error.monad
+ (-> javax/script/ScriptEngine Text _.Expression (Try Any))
+ (do try.monad
[?output (javax/script/ScriptEngine::eval (_.code input) interpreter)
output (case ?output
(#.Some output)
(wrap output)
#.None
- (exception.throw null-has-no-lux-representation []))
- lux-output (..lux-object output)]
- (wrap lux-output)))
+ (exception.throw ..null-has-no-lux-representation []))]
+ (..lux-object output)))
(def: (execute! interpreter alias input)
- (-> javax/script/ScriptEngine Text _.Statement (Error Any))
- (do error.monad
+ (-> javax/script/ScriptEngine Text _.Statement (Try Any))
+ (do try.monad
[?output (javax/script/ScriptEngine::eval (_.code input) interpreter)]
(wrap [])))
-(def: (define! interpreter [module name] input)
- (-> javax/script/ScriptEngine Name _.Expression (Error [Text Any _.Statement]))
- (let [global (format (text.replace-all .module-separator ..separator module)
- ..separator (name.normalize name)
- "___" (%n (text@hash name)))
+(def: (define! interpreter context input)
+ (-> javax/script/ScriptEngine Context _.Expression (Try [Text Any _.Statement]))
+ (let [global (reference.artifact context)
@global (_.var global)]
- (do error.monad
+ (do try.monad
[#let [definition (_.define @global input)]
_ (execute! interpreter global definition)
value (evaluate! interpreter global @global)]
(wrap [global value definition]))))
-(type: Host
- (generation.Host _.Expression _.Statement))
-
(def: host
- (IO Host)
+ (IO (Host _.Expression _.Statement))
(io (let [interpreter (javax/script/ScriptEngineFactory::getScriptEngine
(jdk/nashorn/api/scripting/NashornScriptEngineFactory::new))]
- (: Host
+ (: (Host _.Expression _.Statement)
(structure
- (def: (evaluate! alias input)
- (..evaluate! interpreter (name.normalize alias) input))
+ (def: evaluate! (..evaluate! interpreter))
(def: execute! (..execute! interpreter))
- (def: define! (..define! interpreter)))))))
+ (def: define! (..define! interpreter))
+
+ (def: (ingest context content)
+ (|> content encoding.from-utf8 try.assume (:coerce _.Statement)))
+
+ (def: (re-learn context content)
+ (..execute! interpreter (reference.artifact context) content))
+
+ (def: (re-load context content)
+ (do try.monad
+ [_ (..execute! interpreter "" content)]
+ (..evaluate! interpreter "" (_.var (reference.artifact context))))))))))
(def: platform
- (IO (Platform IO _.Var _.Expression _.Statement))
+ (IO (Platform _.Var _.Expression _.Statement))
(do io.monad
[host ..host]
- (wrap {#platform.&monad io.monad
- #platform.&file-system file.system
+ (wrap {#platform.&file-system (file.async file.system)
#platform.host host
#platform.phase js.generate
- #platform.runtime runtime.generate})))
+ #platform.runtime runtime.generate
+ #platform.write (|>> _.code encoding.to-utf8)})))
-(def: (program program)
- (-> _.Expression _.Statement)
+(def: (program namer context program)
+ (-> (-> Context Text) (Program _.Expression _.Statement))
(let [@process (_.var "process")
raw-inputs (_.? (|> (|> @process _.type-of (_.= (_.string "undefined")) _.not)
(_.and (|> @process (_.the "argv"))))
@@ -458,13 +476,53 @@
(runtime.lux//program-args raw-inputs)
_.null))))
+(def: extender
+ Extender
+ ## TODO: Stop relying on coercions ASAP.
+ (<| (:coerce Extender)
+ (function (@self handler))
+ (:coerce Handler)
+ (function (@self name phase))
+ (:coerce Phase)
+ (function (@self archive parameters))
+ (:coerce Operation)
+ (function (@self state))
+ (:coerce Try)
+ try.assume
+ (:coerce Try)
+ (do try.monad
+ [handler (try.from-maybe (..ensure-macro (:coerce Macro handler)))
+ #let [to-js (: (-> Any java/lang/Object)
+ (|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))]]
+ (jdk/nashorn/api/scripting/JSObject::call #.None
+ (|> (array.new 2)
+ (: (Array java/lang/Object))
+ (array.write 0 (to-js name))
+ (array.write 1 (to-js phase))
+ (array.write 2 (to-js archive))
+ (array.write 3 (to-js parameters))
+ (array.write 4 (to-js state)))
+ (:coerce jdk/nashorn/api/scripting/JSObject handler)))))
+
+(def: (declare-success! _)
+ (-> Any (Promise Any))
+ (promise.future (io.exit +0)))
+
(program: [{service /cli.service}]
- (/.compiler @.js
- ".js"
- ..expander
- analysis/js.bundle
- ..platform
- extension.bundle
- extension/bundle.empty
- ..program
- service))
+ (exec (do promise.monad
+ [_ (/.compiler {#/static.host @.js
+ #/static.host-module-extension ".js"
+ #/static.target (/cli.target service)
+ #/static.artifact-extension ".js"}
+ ..expander
+ analysis.bundle
+ ..platform
+ generation.bundle
+ extension/bundle.empty
+ (..program reference.artifact)
+ ..extender
+ service
+ [(packager.package _.use-strict _.code _.then)
+ (format (/cli.target service) (:: file.system separator) "program.js")])]
+ (..declare-success! []))
+ (io.io [])))
diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux
index d5f9ecb0b..2dcbd5471 100644
--- a/lux-jvm/source/program.lux
+++ b/lux-jvm/source/program.lux
@@ -33,13 +33,13 @@
[language
[lux
[analysis
- ["." macro (#+ Expander)]]
+ [macro (#+ Expander)]]
[phase
[extension (#+ Phase Bundle Operation Handler Extender)
["." analysis #_
["#" jvm]]
- ["." generation #_
- ["#" jvm]]
+ ## ["." generation #_
+ ## ["#" jvm]]
## ["." directive #_
## ["#" jvm]]
]
@@ -151,34 +151,26 @@
(host.array-write 4 (:coerce java/lang/Object state)))
method))))
-(def: (target service)
- (-> /cli.Service /cli.Target)
- (case service
- (^or (#/cli.Compilation [sources libraries target module])
- (#/cli.Interpretation [sources libraries target module])
- (#/cli.Export [sources target]))
- target))
-
(def: (declare-success! _)
(-> Any (Promise Any))
(promise.future (io.exit +0)))
(program: [{service /cli.service}]
- (let [jar-path (format (..target service) (:: file.system separator) "program.jar")]
- (exec (do promise.monad
- [_ (/.compiler {#/static.host @.jvm
- #/static.host-module-extension ".jvm"
- #/static.target (..target service)
- #/static.artifact-extension ".class"}
- ..expander
- analysis.bundle
- ..platform
- ## generation.bundle
- translation.bundle
- (directive.bundle ..extender)
- (jvm/program.program jvm/runtime.class-name)
- ..extender
- service
- [packager.package jar-path])]
- (..declare-success! []))
- (io.io []))))
+ (exec (do promise.monad
+ [_ (/.compiler {#/static.host @.jvm
+ #/static.host-module-extension ".jvm"
+ #/static.target (/cli.target service)
+ #/static.artifact-extension ".class"}
+ ..expander
+ analysis.bundle
+ ..platform
+ ## generation.bundle
+ translation.bundle
+ (directive.bundle ..extender)
+ (jvm/program.program jvm/runtime.class-name)
+ ..extender
+ service
+ [packager.package
+ (format (/cli.target service) (:: file.system separator) "program.jar")])]
+ (..declare-success! []))
+ (io.io [])))
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index 8ffd78b2e..d3176cd4b 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -373,13 +373,12 @@
{#.doc (doc "Generates a unique name as an Code node (ready to be used in code templates)."
"A prefix can be given (or just be empty text) to better identify the code for debugging purposes.")}
(-> Text (Meta Code))
- (function (_ compiler)
- (#try.Success [(update@ #.seed inc compiler)
- (|> compiler
- (get@ #.seed)
- (:: n.decimal encode)
- ($_ text@compose "__gensym__" prefix)
- [""] code.identifier)])))
+ (do ..monad
+ [id ..count]
+ (wrap (|> id
+ (:: n.decimal encode)
+ ($_ text@compose "__gensym__" prefix)
+ [""] code.identifier))))
(def: (get-local-identifier ast)
(-> Code (Meta Text))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux
index 473390cd9..4ec689361 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux
@@ -4,8 +4,7 @@
["." monad (#+ do)]]
[control
["<>" parser
- ["<c>" code (#+ Parser)]]
- pipe]
+ ["<c>" code (#+ Parser)]]]
[data
[collection
["." array (#+ Array)]
@@ -14,185 +13,187 @@
["." check]]
[target
["_" js]]]
- ["." // #_
+ [//
["/" lux (#+ custom)]
- ["/#" //
- ["#." bundle]
- ["/#" // ("#@." monad)
+ [//
+ ["." bundle]
+ [//
[analysis
- [".A" type]]
- ["/#" // #_
- ["#." analysis (#+ Analysis Operation Phase Handler Bundle)]]]]])
+ ["." type]]
+ [//
+ ["." analysis (#+ Analysis Operation Phase Handler Bundle)]
+ [///
+ ["." phase]]]]]])
(def: array::new
Handler
(custom
[<c>.any
- (function (_ extension phase lengthC)
- (do ////.monad
- [lengthA (typeA.with-type Nat
- (phase lengthC))
- [var-id varT] (typeA.with-env check.var)
- _ (typeA.infer (type (Array varT)))]
- (wrap (#/////analysis.Extension extension (list lengthA)))))]))
+ (function (_ extension phase archive lengthC)
+ (do phase.monad
+ [lengthA (type.with-type Nat
+ (phase archive lengthC))
+ [var-id varT] (type.with-env check.var)
+ _ (type.infer (type (Array varT)))]
+ (wrap (#analysis.Extension extension (list lengthA)))))]))
(def: array::length
Handler
(custom
[<c>.any
- (function (_ extension phase arrayC)
- (do ////.monad
- [[var-id varT] (typeA.with-env check.var)
- arrayA (typeA.with-type (type (Array varT))
- (phase arrayC))
- _ (typeA.infer Nat)]
- (wrap (#/////analysis.Extension extension (list arrayA)))))]))
+ (function (_ extension phase archive arrayC)
+ (do phase.monad
+ [[var-id varT] (type.with-env check.var)
+ arrayA (type.with-type (type (Array varT))
+ (phase archive arrayC))
+ _ (type.infer Nat)]
+ (wrap (#analysis.Extension extension (list arrayA)))))]))
(def: array::read
Handler
(custom
[(<>.and <c>.any <c>.any)
- (function (_ extension phase [indexC arrayC])
- (do ////.monad
- [indexA (typeA.with-type Nat
- (phase indexC))
- [var-id varT] (typeA.with-env check.var)
- arrayA (typeA.with-type (type (Array varT))
- (phase arrayC))
- _ (typeA.infer varT)]
- (wrap (#/////analysis.Extension extension (list indexA arrayA)))))]))
+ (function (_ extension phase archive [indexC arrayC])
+ (do phase.monad
+ [indexA (type.with-type Nat
+ (phase archive indexC))
+ [var-id varT] (type.with-env check.var)
+ arrayA (type.with-type (type (Array varT))
+ (phase archive arrayC))
+ _ (type.infer varT)]
+ (wrap (#analysis.Extension extension (list indexA arrayA)))))]))
(def: array::write
Handler
(custom
[($_ <>.and <c>.any <c>.any <c>.any)
- (function (_ extension phase [indexC valueC arrayC])
- (do ////.monad
- [indexA (typeA.with-type Nat
- (phase indexC))
- [var-id varT] (typeA.with-env check.var)
- valueA (typeA.with-type varT
- (phase valueC))
- arrayA (typeA.with-type (type (Array varT))
- (phase arrayC))
- _ (typeA.infer (type (Array varT)))]
- (wrap (#/////analysis.Extension extension (list indexA valueA arrayA)))))]))
+ (function (_ extension phase archive [indexC valueC arrayC])
+ (do phase.monad
+ [indexA (type.with-type Nat
+ (phase archive indexC))
+ [var-id varT] (type.with-env check.var)
+ valueA (type.with-type varT
+ (phase archive valueC))
+ arrayA (type.with-type (type (Array varT))
+ (phase archive arrayC))
+ _ (type.infer (type (Array varT)))]
+ (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))]))
(def: array::delete
Handler
(custom
[($_ <>.and <c>.any <c>.any)
- (function (_ extension phase [indexC arrayC])
- (do ////.monad
- [indexA (typeA.with-type Nat
- (phase indexC))
- [var-id varT] (typeA.with-env check.var)
- arrayA (typeA.with-type (type (Array varT))
- (phase arrayC))
- _ (typeA.infer (type (Array varT)))]
- (wrap (#/////analysis.Extension extension (list indexA arrayA)))))]))
+ (function (_ extension phase archive [indexC arrayC])
+ (do phase.monad
+ [indexA (type.with-type Nat
+ (phase archive indexC))
+ [var-id varT] (type.with-env check.var)
+ arrayA (type.with-type (type (Array varT))
+ (phase archive arrayC))
+ _ (type.infer (type (Array varT)))]
+ (wrap (#analysis.Extension extension (list indexA arrayA)))))]))
(def: bundle::array
Bundle
- (<| (///bundle.prefix "array")
- (|> ///bundle.empty
- (///bundle.install "new" array::new)
- (///bundle.install "length" array::length)
- (///bundle.install "read" array::read)
- (///bundle.install "write" array::write)
- (///bundle.install "delete" array::delete)
+ (<| (bundle.prefix "array")
+ (|> bundle.empty
+ (bundle.install "new" array::new)
+ (bundle.install "length" array::length)
+ (bundle.install "read" array::read)
+ (bundle.install "write" array::write)
+ (bundle.install "delete" array::delete)
)))
(def: object::new
Handler
(custom
[($_ <>.and <c>.any (<c>.tuple (<>.some <c>.any)))
- (function (_ extension phase [constructorC inputsC])
- (do {@ ////.monad}
- [constructorA (typeA.with-type Any
- (phase constructorC))
- inputsA (monad.map @ (|>> phase (typeA.with-type Any)) inputsC)
- _ (typeA.infer .Any)]
- (wrap (#/////analysis.Extension extension (list& constructorA inputsA)))))]))
+ (function (_ extension phase archive [constructorC inputsC])
+ (do {@ phase.monad}
+ [constructorA (type.with-type Any
+ (phase archive constructorC))
+ inputsA (monad.map @ (|>> (phase archive) (type.with-type Any)) inputsC)
+ _ (type.infer .Any)]
+ (wrap (#analysis.Extension extension (list& constructorA inputsA)))))]))
(def: object::get
Handler
(custom
[($_ <>.and <c>.text <c>.any)
- (function (_ extension phase [fieldC objectC])
- (do ////.monad
- [objectA (typeA.with-type Any
- (phase objectC))
- _ (typeA.infer .Any)]
- (wrap (#/////analysis.Extension extension (list (/////analysis.text fieldC)
- objectA)))))]))
+ (function (_ extension phase archive [fieldC objectC])
+ (do phase.monad
+ [objectA (type.with-type Any
+ (phase archive objectC))
+ _ (type.infer .Any)]
+ (wrap (#analysis.Extension extension (list (analysis.text fieldC)
+ objectA)))))]))
(def: object::do
Handler
(custom
[($_ <>.and <c>.text <c>.any (<c>.tuple (<>.some <c>.any)))
- (function (_ extension phase [methodC objectC inputsC])
- (do {@ ////.monad}
- [objectA (typeA.with-type Any
- (phase objectC))
- inputsA (monad.map @ (|>> phase (typeA.with-type Any)) inputsC)
- _ (typeA.infer .Any)]
- (wrap (#/////analysis.Extension extension (list& (/////analysis.text methodC)
- objectA
- inputsA)))))]))
+ (function (_ extension phase archive [methodC objectC inputsC])
+ (do {@ phase.monad}
+ [objectA (type.with-type Any
+ (phase archive objectC))
+ inputsA (monad.map @ (|>> (phase archive) (type.with-type Any)) inputsC)
+ _ (type.infer .Any)]
+ (wrap (#analysis.Extension extension (list& (analysis.text methodC)
+ objectA
+ inputsA)))))]))
(def: bundle::object
Bundle
- (<| (///bundle.prefix "object")
- (|> ///bundle.empty
- (///bundle.install "new" object::new)
- (///bundle.install "get" object::get)
- (///bundle.install "do" object::do)
- (///bundle.install "null" (/.nullary Any))
- (///bundle.install "null?" (/.unary Any Bit))
- (///bundle.install "undefined" (/.nullary Any))
- (///bundle.install "undefined?" (/.unary Any Bit))
+ (<| (bundle.prefix "object")
+ (|> bundle.empty
+ (bundle.install "new" object::new)
+ (bundle.install "get" object::get)
+ (bundle.install "do" object::do)
+ (bundle.install "null" (/.nullary Any))
+ (bundle.install "null?" (/.unary Any Bit))
+ (bundle.install "undefined" (/.nullary Any))
+ (bundle.install "undefined?" (/.unary Any Bit))
)))
(def: js::constant
Handler
(custom
[<c>.text
- (function (_ extension phase name)
- (do ////.monad
- [_ (typeA.infer Any)]
- (wrap (#/////analysis.Extension extension (list (/////analysis.text name))))))]))
+ (function (_ extension phase archive name)
+ (do phase.monad
+ [_ (type.infer Any)]
+ (wrap (#analysis.Extension extension (list (analysis.text name))))))]))
(def: js::apply
Handler
(custom
[($_ <>.and <c>.any (<>.some <c>.any))
- (function (_ extension phase [abstractionC inputsC])
- (do {@ ////.monad}
- [abstractionA (typeA.with-type Any
- (phase abstractionC))
- inputsA (monad.map @ (|>> phase (typeA.with-type Any)) inputsC)
- _ (typeA.infer Any)]
- (wrap (#/////analysis.Extension extension (list& abstractionA inputsA)))))]))
+ (function (_ extension phase archive [abstractionC inputsC])
+ (do {@ phase.monad}
+ [abstractionA (type.with-type Any
+ (phase archive abstractionC))
+ inputsA (monad.map @ (|>> (phase archive) (type.with-type Any)) inputsC)
+ _ (type.infer Any)]
+ (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))]))
(def: js::type-of
Handler
(custom
[<c>.any
- (function (_ extension phase objectC)
- (do ////.monad
- [objectA (typeA.with-type Any
- (phase objectC))
- _ (typeA.infer .Text)]
- (wrap (#/////analysis.Extension extension (list objectA)))))]))
+ (function (_ extension phase archive objectC)
+ (do phase.monad
+ [objectA (type.with-type Any
+ (phase archive objectC))
+ _ (type.infer .Text)]
+ (wrap (#analysis.Extension extension (list objectA)))))]))
(def: #export bundle
Bundle
- (<| (///bundle.prefix "js")
- (|> ///bundle.empty
- (///bundle.install "constant" js::constant)
- (///bundle.install "apply" js::apply)
- (///bundle.install "type-of" js::type-of)
+ (<| (bundle.prefix "js")
+ (|> bundle.empty
+ (bundle.install "constant" js::constant)
+ (bundle.install "apply" js::apply)
+ (bundle.install "type-of" js::type-of)
(dictionary.merge bundle::array)
(dictionary.merge bundle::object)
)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
index e7cebfdbf..114242fd7 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
@@ -10,13 +10,15 @@
["#." case]
["#." loop]
["#." function]
- ["//#" /// #_
- ["." extension]
+ ["/#" // #_
+ ["#." reference]
["/#" // #_
- [analysis (#+)]
- ["." synthesis]
- ["//#" /// #_
- ["#." phase ("#@." monad)]]]]])
+ ["." extension]
+ ["/#" // #_
+ [analysis (#+)]
+ ["." synthesis]
+ ["//#" /// #_
+ ["#." phase ("#@." monad)]]]]]])
(def: #export (generate archive synthesis)
Phase
@@ -36,7 +38,7 @@
(/structure.tuple generate archive members)
(#synthesis.Reference value)
- (/reference@reference archive value)
+ (//reference.reference /reference.system archive value)
(^ (synthesis.branch/case case))
(/case.case generate archive case)
@@ -47,6 +49,9 @@
(^ (synthesis.branch/if if))
(/case.if generate archive if)
+ (^ (synthesis.branch/get get))
+ (/case.get generate archive get)
+
(^ (synthesis.loop/scope scope))
(/loop.scope generate archive scope)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
index 2be5ac6cd..1dc91abe2 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
@@ -1,10 +1,11 @@
(.module:
[lux (#- case let if)
[abstract
- [monad (#+ do)]]
+ ["." monad (#+ do)]]
[control
["ex" exception (#+ exception:)]]
[data
+ ["." maybe]
["." text]
[number
["n" nat]]
@@ -22,15 +23,17 @@
["#." synthesis #_
["#/." case]]
["/#" // #_
- ["#." synthesis (#+ Synthesis Path)]
+ ["#." synthesis (#+ Member Synthesis Path)]
["//#" /// #_
- [reference (#+ Register)]
+ [reference
+ [variable (#+ Register)]]
["#." phase ("#@." monad)]
[meta
[archive (#+ Archive)]]]]]]])
(def: #export register
- (///reference.local _.var))
+ (-> Register Var)
+ (|>> (///reference.local //reference.system) :assume))
(def: #export (let generate archive [valueS register bodyS])
(Generator [Synthesis Register Synthesis])
@@ -42,8 +45,16 @@
(_.return bodyO))
(list valueO)))))
-(def: #export (record-get generate archive [valueS pathP])
- (Generator [Synthesis (List (Either Nat Nat))])
+(def: #export (if generate archive [testS thenS elseS])
+ (Generator [Synthesis Synthesis Synthesis])
+ (do ///////phase.monad
+ [testO (generate archive testS)
+ thenO (generate archive thenS)
+ elseO (generate archive elseS)]
+ (wrap (_.? testO thenO elseO))))
+
+(def: #export (get generate archive [pathP valueS])
+ (Generator [(List Member) Synthesis])
(do ///////phase.monad
[valueO (generate archive valueS)]
(wrap (list@fold (function (_ side source)
@@ -55,15 +66,7 @@
[#.Right //runtime.tuple//right]))]
(method source)))
valueO
- pathP))))
-
-(def: #export (if generate archive [testS thenS elseS])
- (Generator [Synthesis Synthesis Synthesis])
- (do ///////phase.monad
- [testO (generate archive testS)
- thenO (generate archive thenS)
- elseO (generate archive elseS)]
- (wrap (_.? testO thenO elseO))))
+ (list.reverse pathP)))))
(def: @savepoint (_.var "lux_pm_cursor_savepoint"))
(def: @cursor (_.var "lux_pm_cursor"))
@@ -115,9 +118,9 @@
(_.set @temp (|> idx <prep> .int _.i32 (//runtime.sum//get ..peek-cursor <flag>)))
(.if simple?
(_.when (_.= _.null @temp)
- fail-pm!)
+ ..fail-pm!)
(_.if (_.= _.null @temp)
- fail-pm!
+ ..fail-pm!
(push-cursor! @temp)))))]
[left-choice _.null (<|)]
@@ -135,92 +138,125 @@
..restore-cursor!
post!)))
-(def: (pattern-matching' generate archive pathP)
- (-> Phase Archive Path (Operation Statement))
- (.case pathP
- (^ (/////synthesis.path/then bodyS))
- (do ///////phase.monad
- [body! (generate archive bodyS)]
- (wrap (_.return body!)))
-
- #/////synthesis.Pop
- (///////phase@wrap pop-cursor!)
-
- (#/////synthesis.Bind register)
- (///////phase@wrap (_.define (..register register) ..peek-cursor))
-
- (^template [<tag> <format> <=>]
- (^ (<tag> value))
- (///////phase@wrap (_.when (|> value <format> (<=> ..peek-cursor) _.not)
- fail-pm!)))
- ([/////synthesis.path/bit //primitive.bit _.=]
- [/////synthesis.path/i64 (<| //primitive.i64 .int) //runtime.i64//=]
- [/////synthesis.path/f64 //primitive.f64 _.=]
- [/////synthesis.path/text //primitive.text _.=])
-
- (^template [<complex> <simple> <choice>]
- (^ (<complex> idx))
- (///////phase@wrap (<choice> false idx))
-
- (^ (<simple> idx nextP))
- (|> nextP
- (pattern-matching' generate archive)
- (:: ///////phase.monad map (_.then (<choice> true idx)))))
- ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
- [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
-
- (^ (/////synthesis.member/left 0))
- (///////phase@wrap (push-cursor! (_.at (_.i32 +0) ..peek-cursor)))
-
- ## Extra optimization
- (^ (/////synthesis.path/seq
- (/////synthesis.member/left 0)
- (/////synthesis.!bind-top register thenP)))
- (do ///////phase.monad
- [then! (pattern-matching' generate archive thenP)]
- (///////phase@wrap ($_ _.then
- (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor))
- then!)))
-
- (^template [<pm> <getter>]
- (^ (<pm> lefts))
- (///////phase@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor)))
+(def: (pattern-matching' generate archive)
+ (-> Phase Archive
+ (-> Path (Operation Statement)))
+ (function (recur pathP)
+ (.case pathP
+ (#/////synthesis.Then bodyS)
+ (do ///////phase.monad
+ [body! (generate archive bodyS)]
+ (wrap (_.return body!)))
+
+ #/////synthesis.Pop
+ (///////phase@wrap pop-cursor!)
+
+ (#/////synthesis.Bind register)
+ (///////phase@wrap (_.define (..register register) ..peek-cursor))
+
+ (#/////synthesis.Bit-Fork when thenP elseP)
+ (do {@ ///////phase.monad}
+ [then! (recur thenP)
+ else! (.case elseP
+ (#.Some elseP)
+ (recur elseP)
+
+ #.None
+ (wrap ..fail-pm!))]
+ (wrap (.if when
+ (_.if ..peek-cursor
+ then!
+ else!)
+ (_.if ..peek-cursor
+ else!
+ then!))))
+
+ (#/////synthesis.I64-Fork cons)
+ (do {@ ///////phase.monad}
+ [clauses (monad.map @ (function (_ [match then])
+ (do @
+ [then! (recur then)]
+ (wrap [(//runtime.i64//= (//primitive.i64 (.int match))
+ ..peek-cursor)
+ then!])))
+ (#.Cons cons))]
+ (wrap (_.cond clauses ..fail-pm!)))
+
+ (^template [<tag> <format> <type>]
+ (<tag> cons)
+ (do {@ ///////phase.monad}
+ [cases (monad.map @ (function (_ [match then])
+ (:: @ map (|>> [(list (<format> match))]) (recur then)))
+ (#.Cons cons))]
+ (wrap (_.switch ..peek-cursor
+ cases
+ (#.Some ..fail-pm!)))))
+ ([#/////synthesis.F64-Fork //primitive.f64 Frac]
+ [#/////synthesis.Text-Fork //primitive.text Text])
+
+ (^template [<complex> <simple> <choice>]
+ (^ (<complex> idx))
+ (///////phase@wrap (<choice> false idx))
+
+ (^ (<simple> idx nextP))
+ (|> nextP
+ recur
+ (:: ///////phase.monad map (_.then (<choice> true idx)))))
+ ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
+ [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
+
+ (^ (/////synthesis.member/left 0))
+ (///////phase@wrap (push-cursor! (_.at (_.i32 +0) ..peek-cursor)))
## Extra optimization
(^ (/////synthesis.path/seq
- (<pm> lefts)
+ (/////synthesis.member/left 0)
(/////synthesis.!bind-top register thenP)))
(do ///////phase.monad
- [then! (pattern-matching' generate archive thenP)]
+ [then! (recur thenP)]
(///////phase@wrap ($_ _.then
- (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor))
- then!))))
- ([/////synthesis.member/left //runtime.tuple//left]
- [/////synthesis.member/right //runtime.tuple//right])
-
- (^ (/////synthesis.!bind-top register thenP))
- (do ///////phase.monad
- [then! (pattern-matching' generate archive thenP)]
- (///////phase@wrap ($_ _.then
- (_.define (..register register) ..peek-and-pop-cursor)
- then!)))
-
- (^ (/////synthesis.!multi-pop nextP))
- (.let [[extra-pops nextP'] (////synthesis/case.count-pops nextP)]
+ (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor))
+ then!)))
+
+ (^template [<pm> <getter>]
+ (^ (<pm> lefts))
+ (///////phase@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor)))
+
+ ## Extra optimization
+ (^ (/////synthesis.path/seq
+ (<pm> lefts)
+ (/////synthesis.!bind-top register thenP)))
+ (do ///////phase.monad
+ [then! (recur thenP)]
+ (///////phase@wrap ($_ _.then
+ (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor))
+ then!))))
+ ([/////synthesis.member/left //runtime.tuple//left]
+ [/////synthesis.member/right //runtime.tuple//right])
+
+ (^ (/////synthesis.!bind-top register thenP))
(do ///////phase.monad
- [next! (pattern-matching' generate archive nextP')]
+ [then! (recur thenP)]
(///////phase@wrap ($_ _.then
- (multi-pop-cursor! (n.+ 2 extra-pops))
- next!))))
-
- (^template [<tag> <combinator>]
- (^ (<tag> leftP rightP))
- (do ///////phase.monad
- [left! (pattern-matching' generate archive leftP)
- right! (pattern-matching' generate archive rightP)]
- (wrap (<combinator> left! right!))))
- ([/////synthesis.path/seq _.then]
- [/////synthesis.path/alt alternation])))
+ (_.define (..register register) ..peek-and-pop-cursor)
+ then!)))
+
+ (^ (/////synthesis.!multi-pop nextP))
+ (.let [[extra-pops nextP'] (////synthesis/case.count-pops nextP)]
+ (do ///////phase.monad
+ [next! (recur nextP')]
+ (///////phase@wrap ($_ _.then
+ (multi-pop-cursor! (n.+ 2 extra-pops))
+ next!))))
+
+ (^template [<tag> <combinator>]
+ (^ (<tag> leftP rightP))
+ (do ///////phase.monad
+ [left! (recur leftP)
+ right! (recur rightP)]
+ (wrap (<combinator> left! right!))))
+ ([/////synthesis.path/seq _.then]
+ [/////synthesis.path/alt alternation]))))
(def: (pattern-matching generate archive pathP)
(-> Phase Archive Path (Operation Statement))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
index 4a61407da..b2b77ca08 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
@@ -22,7 +22,8 @@
["#." generation]
["//#" /// #_
[arity (#+ Arity)]
- [reference (#+ Register Variable)]
+ [reference
+ [variable (#+ Register Variable)]]
["#." phase ("#@." monad)]]]]])
(def: #export (apply generate archive [functionS argsS+])
@@ -40,7 +41,8 @@
function-definition
_
- (let [capture (///reference.foreign _.var)
+ (let [capture (: (-> Register Var)
+ (|>> (///reference.foreign //reference.system) :assume))
closure (_.closure (|> (list.enumerate inits)
(list@map (|>> product.left capture)))
(_.return function-definition))]
@@ -56,18 +58,15 @@
(def: #export (function generate archive [environment arity bodyS])
(Generator (Abstraction Synthesis))
(do {@ ///////phase.monad}
- [[function-name bodyO] (/////generation.with-new-context
+ [[function-name bodyO] (/////generation.with-new-context archive
(do @
- [function-name (:: @ map ///reference.artifact-name
- /////generation.context)]
+ [function-name (:: @ map ///reference.artifact
+ (/////generation.context archive))]
(/////generation.with-anchor (_.var function-name)
(generate archive bodyS))))
- #let [capture (:: //reference.system variable)]
- closureO+ (: (Operation (List Expression))
- (monad.map @ capture environment))
#let [arityO (|> arity .int _.i32)
@num-args (_.var "num_args")
- @self (_.var (///reference.artifact-name function-name))
+ @self (_.var (///reference.artifact function-name))
apply-poly (.function (_ args func)
(|> func (_.do "apply" (list _.null args))))
initialize-self! (_.define (//case.register 0) @self)
@@ -77,7 +76,7 @@
(_.define (..input post) (_.at (_.i32 (.int post)) @@arguments))))
initialize-self!
(list.indices arity))]]
- (with-closure closureO+
+ (with-closure (list@map (///reference.variable //reference.system) environment)
(_.function @self (list)
($_ _.then
(_.define @num-args (_.the "length" @@arguments))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux
index 183b35650..b748318e5 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux
@@ -3,9 +3,10 @@
[target
["_" js (#+ Expression)]]]
[///
- ["/" reference]])
+ [reference (#+ System)]])
-(def: #export system
- (let [constant (: (-> Text Expression) _.var)
- variable constant]
- (/.system constant variable)))
+(structure: #export system
+ (System Expression)
+
+ (def: constant _.var)
+ (def: variable _.var))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
index ddcc765a2..9356f7f8d 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
@@ -1,18 +1,21 @@
(.module:
[lux #*
[abstract
- [monad (#+ do)]]
+ ["." monad (#+ do)]]
[control
["." function]
["p" parser
["s" code]]]
[data
+ ["." product]
[number (#+ hex)
["." i64]]
["." text
- ["%" format (#+ format)]]
+ ["%" format (#+ format)]
+ ["." encoding]]
[collection
- ["." list ("#@." functor)]]]
+ ["." list ("#@." functor)]
+ ["." row]]]
["." macro
["." code]
[syntax (#+ syntax:)]]
@@ -23,10 +26,11 @@
["//#" /// #_
["#." synthesis]
["#." generation (#+ Buffer)]
- ["//#" /// #_
+ ["//#" /// (#+ Output)
["#." phase]
[meta
- [archive (#+ Archive)]]]]]
+ [archive (#+ Archive)
+ ["." artifact (#+ Registry)]]]]]]
)
(template [<name> <base>]
@@ -42,7 +46,9 @@
(type: #export (Generator i)
(-> Phase Archive i (Operation Expression)))
-(def: prefix Text "LuxRuntime")
+(def: prefix
+ Text
+ "LuxRuntime")
(def: #export high
(-> (I64 Any) (I64 Any))
@@ -87,64 +93,57 @@
(-> Expression Computation)
(..variant (_.i32 +1) (flag #1)))
-(def: variable
- (-> Text Var)
- (|>> ///reference.sanitize
- _.var))
-
-(def: runtime-name
- (-> Text Var)
- (|>> ///reference.sanitize
- (format ..prefix "$")
- _.var))
-
(def: (feature name definition)
(-> Var (-> Var Expression) Statement)
(_.define name (definition name)))
(syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))}
body)
- (wrap (list (` (let [(~+ (|> vars
- (list@map (function (_ var)
- (list (code.local-identifier var)
- (` (_.var (~ (code.text (///reference.sanitize var))))))))
- list.concat))]
- (~ body))))))
+ (do {@ macro.monad}
+ [ids (monad.seq @ (list.repeat (list.size vars) macro.count))]
+ (wrap (list (` (let [(~+ (|> vars
+ (list.zip2 ids)
+ (list@map (function (_ [id var])
+ (list (code.local-identifier var)
+ (` (_.var (~ (code.text (format "v" (%.nat id)))))))))
+ list.concat))]
+ (~ body)))))))
(syntax: (runtime: {declaration (p.or s.local-identifier
(s.form (p.and s.local-identifier
(p.some s.local-identifier))))}
code)
- (case declaration
- (#.Left name)
- (macro.with-gensyms [g!_]
- (let [nameC (code.local-identifier name)
- code-nameC (code.local-identifier (format "@" name))
- runtime-nameC (` (runtime-name (~ (code.text name))))]
- (wrap (list (` (def: #export (~ nameC) Var (~ runtime-nameC)))
- (` (def: (~ code-nameC)
- Statement
- (..feature (~ runtime-nameC)
- (function ((~ g!_) (~ nameC))
- (~ code)))))))))
-
- (#.Right [name inputs])
- (macro.with-gensyms [g!_]
- (let [nameC (code.local-identifier name)
- code-nameC (code.local-identifier (format "@" name))
- runtime-nameC (` (runtime-name (~ (code.text name))))
- inputsC (list@map code.local-identifier inputs)
- inputs-typesC (list@map (function.constant (` _.Expression)) inputs)]
- (wrap (list (` (def: #export ((~ nameC) (~+ inputsC))
- (-> (~+ inputs-typesC) Computation)
- (_.apply/* (~ runtime-nameC) (list (~+ inputsC)))))
- (` (def: (~ code-nameC)
- Statement
- (..feature (~ runtime-nameC)
- (function ((~ g!_) (~ g!_))
- (..with-vars [(~+ inputsC)]
- (_.function (~ g!_) (list (~+ inputsC))
- (~ code)))))))))))))
+ (do macro.monad
+ [id macro.count
+ #let [identifier (format ..prefix (%.nat id))
+ runtime-nameC (` (_.var (~ (code.text identifier))))]]
+ (case declaration
+ (#.Left name)
+ (macro.with-gensyms [g!_]
+ (let [nameC (code.local-identifier name)]
+ (wrap (list (` (def: #export (~ nameC) Var (~ runtime-nameC)))
+ (` (def: (~ (code.local-identifier (format "@" name)))
+ Statement
+ (..feature (~ runtime-nameC)
+ (function ((~ g!_) (~ nameC))
+ (~ code)))))))))
+
+ (#.Right [name inputs])
+ (macro.with-gensyms [g!_]
+ (let [nameC (code.local-identifier name)
+ code-nameC (code.local-identifier (format "@" name))
+ inputsC (list@map code.local-identifier inputs)
+ inputs-typesC (list@map (function.constant (` _.Expression)) inputs)]
+ (wrap (list (` (def: #export ((~ nameC) (~+ inputsC))
+ (-> (~+ inputs-typesC) Computation)
+ (_.apply/* (~ runtime-nameC) (list (~+ inputsC)))))
+ (` (def: (~ (code.local-identifier (format "@" name)))
+ Statement
+ (..feature (~ runtime-nameC)
+ (function ((~ g!_) (~ g!_))
+ (..with-vars [(~+ inputsC)]
+ (_.function (~ g!_) (list (~+ inputsC))
+ (~ code))))))))))))))
(runtime: (lux//try op)
(with-vars [ex]
@@ -725,6 +724,7 @@
(def: runtime
Statement
($_ _.then
+ _.use-strict
runtime//lux
runtime//structure
runtime//i64
@@ -734,14 +734,18 @@
runtime//array
))
-(def: #export artifact Text prefix)
+(def: #export artifact
+ Text
+ prefix)
(def: #export generate
- (Operation (Buffer Statement))
- (/////generation.with-buffer
- (do ///////phase.monad
- [_ (/////generation.save! true ["" ..prefix]
- ($_ _.then
- _.use-strict
- ..runtime))]
- /////generation.buffer)))
+ (Operation [Registry Output])
+ (do ///////phase.monad
+ [_ (/////generation.save! true ["" "0"] ..runtime)]
+ (wrap [(|> artifact.empty
+ artifact.resource
+ product.right)
+ (row.row ["0"
+ (|> ..runtime
+ _.code
+ encoding.to-utf8)])])))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux
index 84efa7c50..d2a4c21e0 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux
@@ -1,98 +1,61 @@
(.module:
[lux #*
- [abstract
- [monad (#+ do)]]
- [control
- pipe]
[data
- ["." text
- ["%" format (#+ format)]]]
- [type (#+ :share)]]
+ [text
+ ["%" format (#+ format)]]]]
["." //// #_
- [synthesis (#+ Synthesis)]
["#." generation (#+ Context)]
["//#" /// #_
- ["#." reference (#+ Register Variable Reference)]
- ["#." phase ("#@." monad)]
+ ["." reference (#+ Reference)
+ ["." variable (#+ Register Variable)]]
+ ["." phase ("#@." monad)]
[meta
[archive (#+ Archive)]]]])
+(def: #export (artifact [module artifact])
+ (-> Context Text)
+ (format "lux_" "m" (%.nat module) "a" (%.nat artifact)))
+
(signature: #export (System expression)
- (: (-> Register expression)
- local)
- (: (-> Register expression)
- foreign)
- (: (All [anchor directive]
- (-> Variable (////generation.Operation anchor expression directive)))
- variable)
- (: (All [anchor directive]
- (-> Archive Name (////generation.Operation anchor expression directive)))
+ (: (-> Text expression)
constant)
- (: (All [anchor directive]
- (-> Archive Reference (////generation.Operation anchor expression directive)))
- reference))
+ (: (-> Text expression)
+ variable))
-(def: (variable-maker prefix variable)
- (All [expression]
- (-> Text (-> Text expression)
- (-> Register expression)))
- (|>> %.nat (format prefix) variable))
+(def: #export (constant system archive name)
+ (All [anchor expression directive]
+ (-> (System expression) Archive Name
+ (////generation.Operation anchor expression directive expression)))
+ (phase@map (|>> ..artifact (:: system constant))
+ (////generation.remember archive name)))
(template [<sigil> <name>]
- [(def: #export <name>
+ [(def: #export (<name> system)
(All [expression]
- (-> (-> Text expression)
+ (-> (System expression)
(-> Register expression)))
- (variable-maker <sigil>))]
+ (|>> %.nat (format <sigil>) (:: system variable)))]
["f" foreign]
["l" local]
)
-(def: #export sanitize
- (-> Text Text)
- (|>> (text.replace-all "-" "_")
- (text.replace-all "?" "Q")
- (text.replace-all "@" "A")))
-
-(def: #export (artifact-name [module id])
- (-> Context Text)
- (format "lux_" "m" (%.nat module) "a" (%.nat id)))
-
-(def: #export (system constant variable)
+(def: #export (variable system variable)
(All [expression]
- (-> (-> Text expression) (-> Text expression)
- (System expression)))
- (let [local (..local variable)
- foreign (..foreign variable)
- variable (:share [expression]
- {(-> Text expression)
- variable}
- {(All [anchor directive]
- (-> Variable (////generation.Operation anchor expression directive)))
- (|>> (case> (#//////reference.Local register)
- (local register)
-
- (#//////reference.Foreign register)
- (foreign register))
- //////phase@wrap)})
- constant (:share [expression]
- {(-> Text expression)
- constant}
- {(All [anchor directive]
- (-> Archive Name (////generation.Operation anchor expression directive)))
- (function (_ archive name)
- (|> (////generation.remember archive name)
- (//////phase@map (|>> ..artifact-name constant))))})]
- (structure
- (def: local local)
- (def: foreign foreign)
- (def: variable variable)
- (def: constant constant)
- (def: (reference archive reference)
- (case reference
- (#//////reference.Constant value)
- (constant archive value)
-
- (#//////reference.Variable value)
- (variable value))))))
+ (-> (System expression) Variable expression))
+ (case variable
+ (#variable.Local register)
+ (..local system register)
+
+ (#variable.Foreign register)
+ (..foreign system register)))
+
+(def: #export (reference system archive reference)
+ (All [anchor expression directive]
+ (-> (System expression) Archive Reference (////generation.Operation anchor expression directive expression)))
+ (case reference
+ (#reference.Constant value)
+ (..constant system archive value)
+
+ (#reference.Variable value)
+ (phase@wrap (..variable system value))))
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/js.lux b/stdlib/source/lux/tool/compiler/meta/packager/js.lux
deleted file mode 100644
index e4c52af5a..000000000
--- a/stdlib/source/lux/tool/compiler/meta/packager/js.lux
+++ /dev/null
@@ -1,36 +0,0 @@
-(.module:
- [lux #*
- [control
- [pipe (#+ case>)]
- ["." function]]
- [data
- [binary (#+ Binary)]
- ["." product]
- ["." text
- ["." encoding]]
- [collection
- ["." row]
- ["." list ("#@." monad fold)]]]
- [target
- ["_" js]]
- [tool
- [compiler
- [phase
- [generation (#+ Output)]]]]])
-
-(def: #export (package outputs)
- (-> (Output _.Statement) Binary)
- (|> outputs
- row.to-list
- (list@map (|>> product.right
- row.to-list
- (list@map product.right)))
- list@join
- (case> (#.Cons head tail)
- (|> (list@fold (function.flip _.then) head tail)
- (: _.Statement)
- _.code
- encoding.to-utf8)
-
- #.Nil
- (encoding.to-utf8 ""))))
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
new file mode 100644
index 000000000..f391e43a8
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
@@ -0,0 +1,106 @@
+(.module:
+ [lux (#- Module Definition)
+ [type (#+ :share)]
+ ["." host (#+ import: do-to)]
+ [abstract
+ ["." monad (#+ Monad do)]]
+ [control
+ ["." try (#+ Try)]
+ [concurrency
+ ["." promise (#+ Promise)]]
+ [security
+ ["!" capability]]]
+ [data
+ ["." binary (#+ Binary)]
+ ["." text
+ ["%" format (#+ format)]
+ ["." encoding]]
+ [number
+ ["n" nat]]
+ [collection
+ ["." row (#+ Row)]
+ ["." list ("#@." functor fold)]]]
+ [target
+ [jvm
+ [encoding
+ ["." name]]]]
+ [world
+ ["." file (#+ File Directory)]]]
+ [program
+ [compositor
+ ["." static (#+ Static)]]]
+ ["." // (#+ Packager)
+ [//
+ ["." archive
+ ["." descriptor (#+ Module)]
+ ["." artifact]]
+ ["." io #_
+ ["#" archive]]
+ [//
+ [language
+ ["$" lux
+ [generation (#+ Context)]
+ [phase
+ [generation
+ [jvm
+ ["." runtime (#+ Definition)]]]]]]]]])
+
+## TODO: Delete ASAP
+(type: (Action ! a)
+ (! (Try a)))
+
+(def: (write-artifact monad file-system static context)
+ (All [!]
+ (-> (Monad !) (file.System !) Static Context
+ (Action ! Binary)))
+ (do (try.with monad)
+ [artifact (let [[module artifact] context]
+ (!.use (:: file-system file) [(io.artifact file-system static module (%.nat artifact))]))]
+ (!.use (:: artifact content) [])))
+
+(def: (write-module monad file-system static sequence [module artifacts] so-far)
+ (All [! directive]
+ (-> (Monad !) (file.System !) Static (-> directive directive directive) [archive.ID (List artifact.ID)] directive
+ (Action ! directive)))
+ (monad.fold (:assume (try.with monad))
+ (function (_ artifact so-far)
+ (do (try.with monad)
+ [content (..write-artifact monad file-system static [module artifact])
+ content (:: monad wrap (encoding.from-utf8 content))]
+ (wrap (sequence so-far
+ (:share [directive]
+ {directive
+ so-far}
+ {directive
+ (:assume artifact)})))))
+ so-far
+ artifacts))
+
+(def: #export (package header to-code sequence)
+ (All [! directive]
+ (-> directive
+ (-> directive Text)
+ (-> directive directive directive)
+ (Packager !)))
+ (function (package monad file-system static archive program)
+ (do {@ (try.with monad)}
+ [cache (:share [!]
+ {(Monad !)
+ monad}
+ {(! (Try (Directory !)))
+ (:assume (!.use (:: file-system directory) [(get@ #static.target static)]))})
+ order (|> archive
+ archive.archived
+ (monad.map try.monad (function (_ module)
+ (do try.monad
+ [[descriptor document] (archive.find module archive)
+ module-id (archive.id module archive)]
+ (wrap (|> descriptor
+ (get@ #descriptor.registry)
+ artifact.artifacts
+ row.to-list
+ (list@map (|>> (get@ #artifact.id)))
+ [module-id])))))
+ (:: monad wrap))]
+ (:: @ map (|>> to-code encoding.to-utf8)
+ (monad.fold @ (..write-module monad file-system static sequence) header order)))))
diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/program/compositor/cli.lux
index e0bcd6e00..03235bbad 100644
--- a/stdlib/source/program/compositor/cli.lux
+++ b/stdlib/source/program/compositor/cli.lux
@@ -1,6 +1,7 @@
(.module:
[lux (#- Module Source)
[control
+ [pipe (#+ case>)]
["<>" parser
["." cli (#+ Parser)]]]
[tool
@@ -31,10 +32,10 @@
(Parser <type>)
(cli.named <long> cli.any))]
- [source "--source" Source]
- [library "--library" Library]
- [target "--target" Target]
- [module "--module" Module]
+ [^source "--source" Source]
+ [^library "--library" Library]
+ [^target "--target" Target]
+ [^module "--module" Module]
)
(def: #export service
@@ -42,18 +43,25 @@
($_ <>.or
(<>.after (cli.this "build")
($_ <>.and
- (<>.some ..source)
- (<>.some ..library)
- ..target
- ..module))
+ (<>.some ..^source)
+ (<>.some ..^library)
+ ..^target
+ ..^module))
(<>.after (cli.this "repl")
($_ <>.and
- (<>.some ..source)
- (<>.some ..library)
- ..target
- ..module))
+ (<>.some ..^source)
+ (<>.some ..^library)
+ ..^target
+ ..^module))
(<>.after (cli.this "export")
($_ <>.and
- (<>.some ..source)
- ..target))
+ (<>.some ..^source)
+ ..^target))
))
+
+(def: #export target
+ (-> Service Target)
+ (|>> (case> (^or (#Compilation [sources libraries target module])
+ (#Interpretation [sources libraries target module])
+ (#Export [sources target]))
+ target)))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index e2d9fb258..8ce6b58b5 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -1,153 +1,139 @@
-(.with-expansions [<host-modules> (.as-is [runtime (#+)]
- [primitive (#+)]
- [structure (#+)]
- [reference (#+)]
- [case (#+)]
- [loop (#+)]
- [function (#+)]
- [extension (#+)])]
- (.module:
- ["/" lux #*
- [abstract
- [monad (#+ do)]
- [predicate (#+ Predicate)]]
- [control
- ["." io (#+ io)]
- [function
- [mixin (#+)]]
- [parser
- [cli (#+ program:)]]]
- [data
- ["." name]
- [number
- ["." i64]
- ["n" nat]
- ["i" int]
- ["r" rev]
- ["f" frac]]]
- ["." math]
- ["_" test (#+ Test)]
- ## These modules do not need to be tested.
- [type
- [variance (#+)]]
- [locale (#+)
- [language (#+)]
- [territory (#+)]]
- ["%" data/text/format (#+ format)]
- [math
- ["." random (#+ Random) ("#@." functor)]]
- ## TODO: Test these modules
- [data
- [format
- [css (#+)]
- [markdown (#+)]]]
- ["@" target
- [js (#+)]
- [python (#+)]
- [lua (#+)]
- [ruby (#+)]
- [php (#+)]
- [common-lisp (#+)]
- [scheme (#+)]]
- ## [tool
- ## [compiler
- ## [language
- ## [lux
- ## [phase
- ## [generation
- ## [jvm (#+)
- ## <host-modules>]
- ## [js (#+)
- ## <host-modules>]
- ## [python (#+)
- ## <host-modules>]
- ## [lua (#+)
- ## <host-modules>]
- ## [ruby (#+)
- ## <host-modules>]
- ## ## [php (#+)
- ## ## <host-modules>]
- ## ## [common-lisp (#+)
- ## ## <host-modules>]
- ## ## [scheme (#+)
- ## ## <host-modules>]
- ## ]
- ## [extension
- ## [generation
- ## [jvm (#+)]
- ## [js (#+)]
- ## [python (#+)]
- ## [lua (#+)]
- ## [ruby (#+)]]]]]]]]
- ## [control
- ## ["._" predicate]
- ## [function
- ## ["._" contract]]
- ## [monad
- ## ["._" free]]
- ## [parser
- ## [type (#+)]]]
- ## [data
- ## ["._" env]
- ## ["._" trace]
- ## ["._" store]
- ## [format
- ## ["._" context]
- ## ["._" html]
- ## ["._" css]
- ## ["._" binary]]
- ## [collection
- ## [tree
- ## [rose
- ## ["._" parser]]]
- ## [dictionary
- ## ["._" plist]]
- ## [set
- ## ["._" multi]]]
- ## [text
- ## ["._" buffer]]]
- ## ["._" macro]
- ## [type
- ## ["._" unit]
- ## ["._" refinement]
- ## ["._" quotient]]
- ## [world
- ## ["._" environment]
- ## ["._" console]]
- ## [compiler
- ## ["._" cli]
- ## ["._" default
- ## ["._" evaluation]
- ## [phase
- ## ["._" generation]
- ## [extension
- ## ["._" directive]]]
- ## ["._default" cache]]
- ## [meta
- ## ["._meta" io
- ## ["._meta_io" context]
- ## ["._meta_io" archive]]
- ## ["._meta" archive]
- ## ["._meta" cache]]]
- ## ["._" interpreter
- ## ["._interpreter" type]]
- ]
- ## TODO: Must have 100% coverage on tests.
- ["." / #_
- ["#." abstract]
- ["#." control]
- ["#." data]
- ["#." macro]
- ["#." math]
- ["#." time]
- ## ["#." tool]
- ["#." type]
- ["#." world]
- ["#." host]
- ["#." extension]
- ["#." target #_
- ["#/." jvm]]]
- ))
+(.module:
+ ["/" lux #*
+ [abstract
+ [monad (#+ do)]
+ [predicate (#+ Predicate)]]
+ [control
+ ["." io (#+ io)]
+ [function
+ [mixin (#+)]]
+ [parser
+ [cli (#+ program:)]]]
+ [data
+ ["." name]
+ [number
+ ["." i64]
+ ["n" nat]
+ ["i" int]
+ ["r" rev]
+ ["f" frac]]]
+ ["." math]
+ ["_" test (#+ Test)]
+ ## These modules do not need to be tested.
+ [type
+ [variance (#+)]]
+ [locale (#+)
+ [language (#+)]
+ [territory (#+)]]
+ ["%" data/text/format (#+ format)]
+ [math
+ ["." random (#+ Random) ("#@." functor)]]
+ ## TODO: Test these modules
+ [data
+ [format
+ [css (#+)]
+ [markdown (#+)]]]
+ ["@" target
+ [js (#+)]
+ [python (#+)]
+ [lua (#+)]
+ [ruby (#+)]
+ [php (#+)]
+ [common-lisp (#+)]
+ [scheme (#+)]]
+ [tool
+ [compiler
+ [language
+ [lux
+ [phase
+ [generation
+ [jvm (#+)]
+ [js (#+)]
+ ## [python (#+)]
+ ## [lua (#+)]
+ ## [ruby (#+)]
+ ## [php (#+)]
+ ## [common-lisp (#+)]
+ ## [scheme (#+)]
+ ]
+ [extension
+ [generation
+ [jvm (#+)]
+ [js (#+)]
+ ## [python (#+)]
+ ## [lua (#+)]
+ ## [ruby (#+)]
+ ]]
+ ]]]]]
+ ## [control
+ ## ["._" predicate]
+ ## [function
+ ## ["._" contract]]
+ ## [monad
+ ## ["._" free]]
+ ## [parser
+ ## [type (#+)]]]
+ ## [data
+ ## ["._" env]
+ ## ["._" trace]
+ ## ["._" store]
+ ## [format
+ ## ["._" context]
+ ## ["._" html]
+ ## ["._" css]
+ ## ["._" binary]]
+ ## [collection
+ ## [tree
+ ## [rose
+ ## ["._" parser]]]
+ ## [dictionary
+ ## ["._" plist]]
+ ## [set
+ ## ["._" multi]]]
+ ## [text
+ ## ["._" buffer]]]
+ ## ["._" macro]
+ ## [type
+ ## ["._" unit]
+ ## ["._" refinement]
+ ## ["._" quotient]]
+ ## [world
+ ## ["._" environment]
+ ## ["._" console]]
+ ## [compiler
+ ## ["._" cli]
+ ## ["._" default
+ ## ["._" evaluation]
+ ## [phase
+ ## ["._" generation]
+ ## [extension
+ ## ["._" directive]]]
+ ## ["._default" cache]]
+ ## [meta
+ ## ["._meta" io
+ ## ["._meta_io" context]
+ ## ["._meta_io" archive]]
+ ## ["._meta" archive]
+ ## ["._meta" cache]]]
+ ## ["._" interpreter
+ ## ["._interpreter" type]]
+ ]
+ ## TODO: Must have 100% coverage on tests.
+ ["." / #_
+ ["#." abstract]
+ ["#." control]
+ ["#." data]
+ ["#." macro]
+ ["#." math]
+ ["#." time]
+ ## ["#." tool]
+ ["#." type]
+ ["#." world]
+ ["#." host]
+ ["#." extension]
+ ["#." target #_
+ ["#/." jvm]]]
+ )
## TODO: Get rid of this ASAP
(template: (!bundle body)
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-02 20:33:22 +0000