aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2020-07-10 00:06:16 -0400
committerEduardo Julian2020-07-10 00:06:16 -0400
commitd48c3ff75f23a62c7f13ff411c25073e618b19de (patch)
treed5d36a4343ca48b765a68b1a665a9089c0d394fd
parent509259d91b07bce77864cf10123ce428461a3092 (diff)
Fixes and improvements to JavaScript compilation.
-rw-r--r--commands.md2
-rw-r--r--lux-js/source/program.lux35
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm.lux5
-rw-r--r--stdlib/source/lux.lux80
-rw-r--r--stdlib/source/lux/control/concurrency/process.lux2
-rw-r--r--stdlib/source/lux/data/binary.lux12
-rw-r--r--stdlib/source/lux/macro/code.lux27
-rw-r--r--stdlib/source/lux/target/js.lux33
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux74
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux60
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux118
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux96
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux13
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/script.lux2
-rw-r--r--stdlib/source/program/licentia.lux3
18 files changed, 355 insertions, 227 deletions
diff --git a/commands.md b/commands.md
index edfd16b66..90235dee2 100644
--- a/commands.md
+++ b/commands.md
@@ -139,7 +139,7 @@ cd ~/lux/lux-jvm/ && java -jar target/program.jar repl --source ~/lux/stdlib/sou
```
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/ && lein clean && 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
diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux
index cebede1ab..3ecd9891b 100644
--- a/lux-js/source/program.lux
+++ b/lux-js/source/program.lux
@@ -13,6 +13,7 @@
[concurrency
["." promise (#+ Promise)]]]
[data
+ ["." product]
["." maybe]
[number
["." i64]
@@ -32,6 +33,8 @@
[tool
[compiler
[phase (#+ Operation Phase)]
+ [reference
+ [variable (#+ Register)]]
[language
[lux
[program (#+ Program)]
@@ -145,7 +148,7 @@
(|> value .nat runtime.low jvm-int)
_
- (error! (exception.construct unknown-member [member (:coerce java/lang/Object value)]))))
+ (error! (exception.construct ..unknown-member [member (:coerce java/lang/Object value)]))))
))
(def: (::toString js-object)
@@ -228,7 +231,7 @@
(|> value (array.read 2) maybe.assume js-object (:coerce java/lang/Object))
_
- (error! (exception.construct unknown-member [(:coerce Text member) (:coerce java/lang/Object value)])))
+ (error! (exception.construct ..unknown-member [(:coerce Text member) (:coerce java/lang/Object value)])))
)
(jdk/nashorn/api/scripting/AbstractJSObject
[] (getSlot self {idx int}) java/lang/Object
@@ -239,7 +242,14 @@
(:coerce java/lang/Object)))
)))
-(exception: null-has-no-lux-representation)
+(exception: (null-has-no-lux-representation {code (Maybe _.Expression)})
+ (case code
+ (#.Some code)
+ (_.code code)
+
+ #.None
+ "???"))
+
(exception: undefined-has-no-lux-representation)
(exception: (unknown-kind-of-host-object {object java/lang/Object})
@@ -322,7 +332,7 @@
(def: (lux-object js-object)
(-> java/lang/Object (Try Any))
(`` (<| (if (host.null? js-object)
- (exception.throw ..null-has-no-lux-representation []))
+ (exception.throw ..null-has-no-lux-representation [#.None]))
(case (host.check jdk/nashorn/internal/runtime/Undefined js-object)
(#.Some _)
(exception.throw ..undefined-has-no-lux-representation [])
@@ -391,7 +401,7 @@
(def: (expander macro inputs lux)
Expander
- (case (ensure-macro macro)
+ (case (..ensure-macro macro)
(#.Some macro)
(case (call-macro inputs lux macro)
(#try.Success output)
@@ -409,14 +419,13 @@
(def: (evaluate! interpreter alias input)
(-> 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)
+ [?output (javax/script/ScriptEngine::eval (_.code input) interpreter)]
+ (case ?output
+ (#.Some output)
+ (..lux-object output)
- #.None
- (exception.throw ..null-has-no-lux-representation []))]
- (..lux-object output)))
+ #.None
+ (exception.throw ..null-has-no-lux-representation [(#.Some input)]))))
(def: (execute! interpreter alias input)
(-> javax/script/ScriptEngine Text _.Statement (Try Any))
@@ -456,7 +465,7 @@
(..evaluate! interpreter "" (_.var (reference.artifact context))))))))))
(def: platform
- (IO (Platform _.Var _.Expression _.Statement))
+ (IO (Platform [Register Text] _.Expression _.Statement))
(do io.monad
[host ..host]
(wrap {#platform.&file-system (file.async file.system)
diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux
index 141e70184..cebd5e652 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm.lux
@@ -27,8 +27,9 @@
[compiler
[language
[lux
+ ["." version]
["." generation]]]
- ["." meta
+ [meta
[io (#+ lux-context)]
[archive
[descriptor (#+ Module)]
@@ -99,7 +100,7 @@
(def: #export (class-name [module-id artifact-id])
(-> generation.Context Text)
(format lux-context
- ..class-path-separator (%.nat meta.version)
+ ..class-path-separator (%.nat version.version)
..class-path-separator (%.nat module-id)
..class-path-separator (%.nat artifact-id)))
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index d6fa1c40a..2409d3f39 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2090,17 +2090,6 @@
template}
template))
-(def:''' (join-map f xs)
- #Nil
- (All [a b]
- (-> (-> a ($' List b)) ($' List a) ($' List b)))
- ({#Nil
- #Nil
-
- (#Cons [x xs'])
- (list@compose (f x) (join-map f xs'))}
- xs))
-
(def:''' (every? p xs)
#Nil
(All [a]
@@ -2142,6 +2131,12 @@
#1
("lux i64 =" reference sample)))
+(def:''' (list@join xs)
+ #Nil
+ (All [a]
+ (-> ($' List ($' List a)) ($' List a)))
+ (list@fold list@compose #Nil (list@reverse xs)))
+
(macro:' #export (template tokens)
(list [(tag$ ["lux" "doc"])
(text$ ($_ "lux text concat"
@@ -2158,7 +2153,8 @@
(if (every? (function' [size] ("lux i64 =" num-bindings size))
(list@map list@size data'))
(|> data'
- (join-map (compose apply (make-env bindings')))
+ (list@map (compose apply (make-env bindings')))
+ list@join
return)
(fail "Irregular arguments tuples for template.")))
@@ -2350,12 +2346,6 @@
#None #0}
output))))
-(def:''' (list@join xs)
- #Nil
- (All [a]
- (-> ($' List ($' List a)) ($' List a)))
- (list@fold list@compose #Nil (list@reverse xs)))
-
(def:''' (interpose sep xs)
#Nil
(All [a]
@@ -3253,38 +3243,6 @@
(-> Text Text (Maybe Nat))
("lux text index" 0 part text))
-(def: (last-index-of' part part-size since text)
- (-> Text Nat Nat Text (Maybe Nat))
- (case ("lux text index" ("lux i64 +" part-size since) part text)
- #None
- (#Some since)
-
- (#Some since')
- (last-index-of' part part-size since' text)))
-
-(def: (last-index-of part text)
- (-> Text Text (Maybe Nat))
- (case ("lux text index" 0 part text)
- (#Some since)
- (last-index-of' part ("lux text size" part) since text)
-
- #None
- #None))
-
-(def: (clip/1 from text)
- (-> Nat Text (Maybe Text))
- (let [size ("lux text size" text)]
- (if (n/<= size from)
- (#.Some ("lux text clip" from size text))
- #.None)))
-
-(def: (clip/2 from to text)
- (-> Nat Nat Text (Maybe Text))
- (if (and (n/<= to from)
- (n/<= ("lux text size" text) to))
- (#.Some ("lux text clip" from to text))
- #.None))
-
(def: #export (error! message)
{#.doc (text$ ($_ "lux text concat"
"## Causes an error, with the given error message." ..new-line
@@ -3316,7 +3274,7 @@
(def: (text@split-all-with splitter input)
(-> Text Text (List Text))
- (case (index-of splitter input)
+ (case (..index-of splitter input)
#None
(list input)
@@ -3766,13 +3724,13 @@
(^ (list& [_ (#Form (list& [_ (#Tag ["" "only"])] defs))] tokens')))
(do meta-monad
[defs' (extract-defs defs)]
- (return [(#Only defs') tokens']))
+ (wrap [(#Only defs') tokens']))
(^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "-"])] defs))] tokens'))
(^ (list& [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))] tokens')))
(do meta-monad
[defs' (extract-defs defs)]
- (return [(#Exclude defs') tokens']))
+ (wrap [(#Exclude defs') tokens']))
(^or (^ (list& [_ (#Tag ["" "*"])] tokens'))
(^ (list& [_ (#Tag ["" "all"])] tokens')))
@@ -4542,12 +4500,13 @@
(function (_ def)
(` ("lux def alias" (~ (local-identifier$ def)) (~ (identifier$ [module-name def]))))))
defs')
- openings (join-map (: (-> Openings (List Code))
- (function (_ [alias structs])
- (list@map (function (_ name)
- (` (open: (~ (text$ alias)) (~ (identifier$ [module-name name])))))
- structs)))
- r-opens)]]
+ openings (|> r-opens
+ (list@map (: (-> Openings (List Code))
+ (function (_ [alias structs])
+ (list@map (function (_ name)
+ (` (open: (~ (text$ alias)) (~ (identifier$ [module-name name])))))
+ structs))))
+ list@join)]]
(wrap (list@compose defs openings))
))
@@ -4856,7 +4815,8 @@
(let [apply (: (-> RepEnv (List Code))
(function (_ env) (list@map (apply-template env) templates)))]
(|> data'
- (join-map (compose apply (make-env bindings')))
+ (list@map (compose apply (make-env bindings')))
+ list@join
wrap))
#None))))
(#Some output)
diff --git a/stdlib/source/lux/control/concurrency/process.lux b/stdlib/source/lux/control/concurrency/process.lux
index 4d6cc8cb3..3b273753a 100644
--- a/stdlib/source/lux/control/concurrency/process.lux
+++ b/stdlib/source/lux/control/concurrency/process.lux
@@ -152,6 +152,6 @@
(do @
[_ (monad.map @ (get@ #action) ready)]
(wrap []))
- (error! (ex.construct cannot-continue-running-processes []))))
+ (error! (ex.construct ..cannot-continue-running-processes []))))
))))
))
diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux
index 4d3eb962a..30c2bc193 100644
--- a/stdlib/source/lux/data/binary.lux
+++ b/stdlib/source/lux/data/binary.lux
@@ -12,7 +12,8 @@
["." maybe]
[number
["." i64]
- ["n" nat]]
+ ["n" nat]
+ ["f" frac]]
[text
["%" format (#+ format)]]
[collection
@@ -84,7 +85,7 @@
(host.array-length binary)
@.js
- (.frac-to-nat (Uint8Array::length binary))}))
+ (f.nat (Uint8Array::length binary))}))
(template: (!read idx binary)
(for {@.old
@@ -98,7 +99,8 @@
(: ..Binary)
(:coerce (array.Array .Frac))
("js array read" idx)
- .frac-to-nat)}))
+ f.nat
+ .i64)}))
(template: (!write idx value binary)
(for {@.old
@@ -111,7 +113,7 @@
(|> binary
(: ..Binary)
(:coerce (array.Array .Frac))
- ("js array write" idx (.nat-to-frac value))
+ ("js array write" idx (n.frac (.nat value)))
(:coerce ..Binary))}))
(def: #export size
@@ -127,7 +129,7 @@
(|>> (host.array byte))
@.js
- (|>> .nat-to-frac [] ArrayBuffer::new Uint8Array::new)}))
+ (|>> n.frac [] ArrayBuffer::new Uint8Array::new)}))
(def: #export (fold f init binary)
(All [a] (-> (-> I64 a a) a Binary a))
diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux
index 219bb76e4..8b868db58 100644
--- a/stdlib/source/lux/macro/code.lux
+++ b/stdlib/source/lux/macro/code.lux
@@ -10,9 +10,9 @@
["." int]
["." rev]
["." frac]]
- ["." text ("#@." monoid)]
+ ["." text ("#@." monoid equivalence)]
[collection
- ["." list ("#@." functor)]]]])
+ ["." list ("#@." functor fold)]]]])
## (type: (Code' w)
## (#.Bit Bit)
@@ -109,10 +109,13 @@
[_ (<tag> members)]
($_ text@compose
<open>
- (|> members
- (list@map to-text)
- (list.interpose " ")
- (text.join-with ""))
+ (list@fold (function (_ next prev)
+ (let [next (to-text next)]
+ (if (text@= "" prev)
+ next
+ ($_ text@compose prev " " next))))
+ ""
+ members)
<close>))
([#.Form "(" ")"]
[#.Tuple "[" "]"])
@@ -120,11 +123,13 @@
[_ (#.Record pairs)]
($_ text@compose
"{"
- (|> pairs
- (list@map (function (_ [left right])
- ($_ text@compose (to-text left) " " (to-text right))))
- (list.interpose " ")
- (text.join-with ""))
+ (list@fold (function (_ [left right] prev)
+ (let [next ($_ text@compose (to-text left) " " (to-text right))]
+ (if (text@= "" prev)
+ next
+ ($_ text@compose prev " " next))))
+ ""
+ pairs)
"}")
))
diff --git a/stdlib/source/lux/target/js.lux b/stdlib/source/lux/target/js.lux
index b66f40e05..429579655 100644
--- a/stdlib/source/lux/target/js.lux
+++ b/stdlib/source/lux/target/js.lux
@@ -79,18 +79,19 @@
(def: sanitize
(-> Text Text)
- (`` (|>> (~~ (template [<find> <replace>]
+ (`` (|>> (~~ (template [<replace> <find>]
[(text.replace-all <find> <replace>)]
- ["\" "\\"]
- [text.tab "\t"]
- [text.vertical-tab "\v"]
- [text.null "\0"]
- [text.back-space "\b"]
- [text.form-feed "\f"]
- [text.new-line "\n"]
- [text.carriage-return "\r"]
- [text.double-quote (format "\" text.double-quote)]
+ ["\\" "\"]
+ ["\t" text.tab]
+ ["\v" text.vertical-tab]
+ ["\0" text.null]
+ ["\b" text.back-space]
+ ["\f" text.form-feed]
+ ["\n" text.new-line]
+ ["\r" text.carriage-return]
+ [(format "\" text.double-quote)
+ text.double-quote]
))
)))
@@ -170,8 +171,8 @@
(text.enclose ["{"
close]))))
- (def: #export (function name inputs body)
- (-> Var (List Var) Statement Computation)
+ (def: #export (function! name inputs body)
+ (-> Var (List Var) Statement Statement)
(|> body
..block
(format "function " (:representation name)
@@ -180,6 +181,12 @@
(text.join-with ..argument-separator)
..argument)
" ")
+ :abstraction))
+
+ (def: #export (function name inputs body)
+ (-> Var (List Var) Statement Computation)
+ (|> (..function! name inputs body)
+ :representation
..argument
:abstraction))
@@ -392,7 +399,7 @@
(def: #export (switch input cases default)
(-> Expression (List [(List Literal) Statement]) (Maybe Statement) Statement)
- (:abstraction (format "switch (" (:representation input) ")" text.new-line
+ (:abstraction (format "switch (" (:representation input) ") "
(|> (format (|> cases
(list@map (.function (_ [when then])
(format (|> when
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 114242fd7..76496ae82 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
@@ -1,9 +1,13 @@
(.module:
[lux #*
[abstract
- [monad (#+ do)]]]
+ [monad (#+ do)]]
+ [control
+ ["." exception (#+ exception:)]]
+ [target
+ ["_" js]]]
["." / #_
- [runtime (#+ Phase)]
+ [runtime (#+ Phase Phase!)]
["#." primitive]
["#." structure]
["#." reference ("#@." system)]
@@ -20,7 +24,45 @@
["//#" /// #_
["#." phase ("#@." monad)]]]]]])
-(def: #export (generate archive synthesis)
+(exception: #export cannot-recur-as-an-expression)
+
+(def: (statement expression archive synthesis)
+ Phase!
+ (case synthesis
+ (^template [<tag>]
+ (^ (<tag> value))
+ (//////phase@map _.return (expression archive synthesis)))
+ ([synthesis.bit]
+ [synthesis.i64]
+ [synthesis.f64]
+ [synthesis.text]
+ [synthesis.variant]
+ [synthesis.tuple]
+ [#synthesis.Reference]
+ [synthesis.branch/get]
+ [synthesis.function/apply]
+ [#synthesis.Extension])
+
+ (^ (synthesis.branch/case case))
+ (/case.case! statement expression archive case)
+
+ (^ (synthesis.branch/let let))
+ (/case.let! statement expression archive let)
+
+ (^ (synthesis.branch/if if))
+ (/case.if! statement expression archive if)
+
+ (^ (synthesis.loop/scope scope))
+ (/loop.scope! statement expression archive scope)
+
+ (^ (synthesis.loop/recur updates))
+ (/loop.recur! statement expression archive updates)
+
+ (^ (synthesis.function/abstraction abstraction))
+ (//////phase@map _.return (/function.function statement expression archive abstraction))
+ ))
+
+(def: (expression archive synthesis)
Phase
(case synthesis
(^template [<tag> <generator>]
@@ -32,38 +74,42 @@
[synthesis.text /primitive.text])
(^ (synthesis.variant variantS))
- (/structure.variant generate archive variantS)
+ (/structure.variant expression archive variantS)
(^ (synthesis.tuple members))
- (/structure.tuple generate archive members)
+ (/structure.tuple expression archive members)
(#synthesis.Reference value)
(//reference.reference /reference.system archive value)
(^ (synthesis.branch/case case))
- (/case.case generate archive case)
+ (/case.case ..statement expression archive case)
(^ (synthesis.branch/let let))
- (/case.let generate archive let)
+ (/case.let expression archive let)
(^ (synthesis.branch/if if))
- (/case.if generate archive if)
+ (/case.if expression archive if)
(^ (synthesis.branch/get get))
- (/case.get generate archive get)
+ (/case.get expression archive get)
(^ (synthesis.loop/scope scope))
- (/loop.scope generate archive scope)
+ (/loop.scope ..statement expression archive scope)
(^ (synthesis.loop/recur updates))
- (/loop.recur generate archive updates)
+ (//////phase.throw ..cannot-recur-as-an-expression [])
(^ (synthesis.function/abstraction abstraction))
- (/function.function generate archive abstraction)
+ (/function.function ..statement expression archive abstraction)
(^ (synthesis.function/apply application))
- (/function.apply generate archive application)
+ (/function.apply expression archive application)
(#synthesis.Extension extension)
- (extension.apply archive generate extension)
+ (extension.apply archive expression extension)
))
+
+(def: #export generate
+ Phase
+ ..expression)
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 700411c5f..ab1cc08de 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
@@ -14,7 +14,7 @@
[target
["_" js (#+ Expression Computation Var Statement)]]]
["." // #_
- ["#." runtime (#+ Operation Phase Generator)]
+ ["#." runtime (#+ Operation Phase Phase! Generator Generator!)]
["#." reference]
["#." primitive]
["/#" // #_
@@ -40,11 +40,18 @@
(do ///////phase.monad
[valueO (generate archive valueS)
bodyO (generate archive bodyS)]
- ## TODO: Find some way to do 'let' without paying the price of the closure.
(wrap (_.apply/* (_.closure (list (..register register))
(_.return bodyO))
(list valueO)))))
+(def: #export (let! statement expression archive [valueS register bodyS])
+ (Generator! [Synthesis Register Synthesis])
+ (do ///////phase.monad
+ [valueO (expression archive valueS)
+ bodyO (statement expression archive bodyS)]
+ (wrap (_.then (_.define (..register register) valueO)
+ bodyO))))
+
(def: #export (if generate archive [testS thenS elseS])
(Generator [Synthesis Synthesis Synthesis])
(do ///////phase.monad
@@ -53,6 +60,16 @@
elseO (generate archive elseS)]
(wrap (_.? testO thenO elseO))))
+(def: #export (if! statement expression archive [testS thenS elseS])
+ (Generator! [Synthesis Synthesis Synthesis])
+ (do ///////phase.monad
+ [testO (expression archive testS)
+ thenO (statement expression archive thenS)
+ elseO (statement expression archive elseS)]
+ (wrap (_.if testO
+ thenO
+ elseO))))
+
(def: #export (get generate archive [pathP valueS])
(Generator [(List Member) Synthesis])
(do ///////phase.monad
@@ -138,8 +155,8 @@
..restore-cursor!
post!)))
-(def: (optimized-pattern-matching recur generate archive pathP)
- (-> (-> Path (Operation Statement)) Phase Archive
+(def: (optimized-pattern-matching recur pathP)
+ (-> (-> Path (Operation Statement))
(-> Path (Operation (Maybe Statement))))
(.case pathP
(^template [<simple> <choice>]
@@ -194,12 +211,12 @@
_
(///////phase@wrap #.None)))
-(def: (pattern-matching' generate archive)
- (-> Phase Archive
+(def: (pattern-matching' statement expression archive)
+ (-> Phase! Phase Archive
(-> Path (Operation Statement)))
(function (recur pathP)
(do ///////phase.monad
- [outcome (optimized-pattern-matching recur generate archive pathP)]
+ [outcome (optimized-pattern-matching recur pathP)]
(.case outcome
(#.Some outcome)
(wrap outcome)
@@ -253,9 +270,7 @@
[#/////synthesis.Text-Fork //primitive.text Text])
(#/////synthesis.Then bodyS)
- (do ///////phase.monad
- [body! (generate archive bodyS)]
- (wrap (_.return body!)))
+ (statement expression archive bodyS)
(^template [<complex> <choice>]
(^ (<complex> idx))
@@ -278,20 +293,20 @@
([/////synthesis.path/seq _.then]
[/////synthesis.path/alt ..alternation]))))))
-(def: (pattern-matching generate archive pathP)
- (-> Phase Archive Path (Operation Statement))
+(def: (pattern-matching statement expression archive pathP)
+ (-> Phase! Phase Archive Path (Operation Statement))
(do ///////phase.monad
- [pattern-matching! (pattern-matching' generate archive pathP)]
+ [pattern-matching! (pattern-matching' statement expression archive pathP)]
(wrap ($_ _.then
(_.do-while (_.boolean false)
pattern-matching!)
(_.throw (_.string ////synthesis/case.pattern-matching-error))))))
-(def: #export (case generate archive [valueS pathP])
- (Generator [Synthesis Path])
+(def: #export (case statement expression archive [valueS pathP])
+ (-> Phase! (Generator [Synthesis Path]))
(do ///////phase.monad
- [stack-init (generate archive valueS)
- path! (pattern-matching generate archive pathP)
+ [stack-init (expression archive valueS)
+ path! (pattern-matching statement expression archive pathP)
#let [closure (<| (_.closure (list))
($_ _.then
(_.declare @temp)
@@ -299,3 +314,14 @@
(_.define @savepoint (_.array (list)))
path!))]]
(wrap (_.apply/* closure (list)))))
+
+(def: #export (case! statement expression archive [valueS pathP])
+ (Generator! [Synthesis Path])
+ (do ///////phase.monad
+ [stack-init (expression archive valueS)
+ path! (pattern-matching statement expression archive pathP)]
+ (wrap ($_ _.then
+ (_.declare @temp)
+ (_.define @cursor (_.array (list stack-init)))
+ (_.define @savepoint (_.array (list)))
+ path!))))
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 b2b77ca08..3b491fd8e 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
@@ -6,12 +6,14 @@
pipe]
[data
["." product]
+ [text
+ ["%" format (#+ format)]]
[collection
["." list ("#@." functor fold)]]]
[target
- ["_" js (#+ Expression Computation Var)]]]
+ ["_" js (#+ Expression Computation Var Statement)]]]
["." // #_
- ["#." runtime (#+ Operation Phase Generator)]
+ ["#." runtime (#+ Operation Phase Phase! Generator)]
["#." reference]
["#." case]
["/#" // #_
@@ -19,7 +21,7 @@
["//#" /// #_
[analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
[synthesis (#+ Synthesis)]
- ["#." generation]
+ ["#." generation (#+ Context)]
["//#" /// #_
[arity (#+ Arity)]
[reference
@@ -33,20 +35,21 @@
argsO+ (monad.map @ (generate archive) argsS+)]
(wrap (_.apply/* functionO argsO+))))
-(def: (with-closure inits function-definition)
- (-> (List Expression) Computation (Operation Computation))
- (///////phase@wrap
- (case inits
- #.Nil
- function-definition
+(def: (with-closure @self inits function-body)
+ (-> Var (List Expression) Statement [Statement Expression])
+ (case inits
+ #.Nil
+ [(_.function! @self (list) function-body)
+ @self]
- _
- (let [capture (: (-> Register Var)
- (|>> (///reference.foreign //reference.system) :assume))
- closure (_.closure (|> (list.enumerate inits)
- (list@map (|>> product.left capture)))
- (_.return function-definition))]
- (_.apply/* closure inits)))))
+ _
+ (let [capture (: (-> Register Var)
+ (|>> (///reference.foreign //reference.system) :assume))]
+ [(_.function! @self
+ (|> (list.enumerate inits)
+ (list@map (|>> product.left capture)))
+ (_.return (_.function @self (list) function-body)))
+ (_.apply/* @self inits)])))
(def: @curried (_.var "curried"))
@@ -55,17 +58,22 @@
(def: @@arguments (_.var "arguments"))
-(def: #export (function generate archive [environment arity bodyS])
- (Generator (Abstraction Synthesis))
+(def: (@scope function-name)
+ (-> Context Text)
+ (format (///reference.artifact function-name) "_scope"))
+
+(def: #export (function statement expression archive [environment arity bodyS])
+ (-> Phase! (Generator (Abstraction Synthesis)))
(do {@ ///////phase.monad}
- [[function-name bodyO] (/////generation.with-new-context archive
+ [[function-name body!] (/////generation.with-new-context archive
(do @
- [function-name (:: @ map ///reference.artifact
- (/////generation.context archive))]
- (/////generation.with-anchor (_.var function-name)
- (generate archive bodyS))))
+ [scope (:: @ map ..@scope
+ (/////generation.context archive))]
+ (/////generation.with-anchor [1 scope]
+ (statement expression archive bodyS))))
#let [arityO (|> arity .int _.i32)
@num-args (_.var "num_args")
+ @scope (..@scope function-name)
@self (_.var (///reference.artifact function-name))
apply-poly (.function (_ args func)
(|> func (_.do "apply" (list _.null args))))
@@ -75,34 +83,36 @@
pre!
(_.define (..input post) (_.at (_.i32 (.int post)) @@arguments))))
initialize-self!
- (list.indices arity))]]
- (with-closure (list@map (///reference.variable //reference.system) environment)
- (_.function @self (list)
- ($_ _.then
- (_.define @num-args (_.the "length" @@arguments))
- (_.cond (list [(|> @num-args (_.= arityO))
- ($_ _.then
- initialize!
- (_.return bodyO))]
- [(|> @num-args (_.> arityO))
- (let [arity-inputs (|> (_.array (list))
- (_.the "slice")
- (_.do "call" (list @@arguments (_.i32 +0) arityO)))
- extra-inputs (|> (_.array (list))
- (_.the "slice")
- (_.do "call" (list @@arguments arityO)))]
- (_.return (|> @self
- (apply-poly arity-inputs)
- (apply-poly extra-inputs))))])
- ## (|> @num-args (_.< arityO))
- (let [all-inputs (|> (_.array (list))
- (_.the "slice")
- (_.do "call" (list @@arguments)))]
- ($_ _.then
- (_.define @curried all-inputs)
- (_.return (_.closure (list)
- (let [@missing all-inputs]
- (_.return (apply-poly (_.do "concat" (list @missing) @curried)
- @self))))))))
- )))
- ))
+ (list.indices arity))
+ [definition instantiation] (with-closure @self (list@map (///reference.variable //reference.system) environment)
+ ($_ _.then
+ (_.define @num-args (_.the "length" @@arguments))
+ (_.cond (list [(|> @num-args (_.= arityO))
+ ($_ _.then
+ initialize!
+ (_.with-label (_.label @scope)
+ (_.do-while (_.boolean true)
+ body!)))]
+ [(|> @num-args (_.> arityO))
+ (let [arity-inputs (|> (_.array (list))
+ (_.the "slice")
+ (_.do "call" (list @@arguments (_.i32 +0) arityO)))
+ extra-inputs (|> (_.array (list))
+ (_.the "slice")
+ (_.do "call" (list @@arguments arityO)))]
+ (_.return (|> @self
+ (apply-poly arity-inputs)
+ (apply-poly extra-inputs))))])
+ ## (|> @num-args (_.< arityO))
+ (let [all-inputs (|> (_.array (list))
+ (_.the "slice")
+ (_.do "call" (list @@arguments)))]
+ ($_ _.then
+ (_.define @curried all-inputs)
+ (_.return (_.closure (list)
+ (let [@missing all-inputs]
+ (_.return (apply-poly (_.do "concat" (list @missing) @curried)
+ @self))))))))
+ ))]
+ _ (/////generation.save! true ["" (%.nat (product.right function-name))] definition)]
+ (wrap instantiation)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
index 096993996..8863b30a3 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
@@ -4,47 +4,95 @@
["." monad (#+ do)]]
[data
["." product]
- ["." text]
+ ["." text
+ ["%" format (#+ format)]]
[number
["n" nat]]
[collection
- ["." list ("#@." functor)]]]
+ ["." list ("#@." functor fold)]]]
[target
- ["_" js (#+ Computation Var)]]]
+ ["_" js (#+ Computation Var Expression Statement)]]]
["." // #_
- [runtime (#+ Operation Phase Generator)]
+ [runtime (#+ Operation Phase Phase! Generator Generator!)]
["#." case]
["///#" //// #_
[synthesis (#+ Scope Synthesis)]
["#." generation]
["//#" /// #_
- ["#." phase]]]])
+ ["#." phase]
+ [reference
+ [variable (#+ Register)]]]]])
-(def: @scope (_.var "scope"))
+(def: @scope
+ (-> Nat Text)
+ (|>> %.nat (format "scope")))
-(def: #export (scope generate archive [start initsS+ bodyS])
- (Generator (Scope Synthesis))
+(def: (setup initial? offset bindings body)
+ (-> Bit Register (List Expression) Statement Statement)
+ (|> bindings
+ list.enumerate
+ (list@map (function (_ [register value])
+ (let [variable (//case.register (n.+ offset register))]
+ (if initial?
+ (_.define variable value)
+ (_.set variable value)))))
+ list.reverse
+ (list@fold _.then body)))
+
+(def: #export (scope! statement expression archive [start initsS+ bodyS])
+ (Generator! (Scope Synthesis))
(case initsS+
## function/false/non-independent loop
#.Nil
- (generate archive bodyS)
+ (statement expression archive bodyS)
## true loop
_
- (do {@ ///////phase.monad}
- [initsO+ (monad.map @ (generate archive) initsS+)
- bodyO (/////generation.with-anchor @scope
- (generate archive bodyS))
- #let [closure (_.function @scope
- (|> initsS+
- list.enumerate
- (list@map (|>> product.left (n.+ start) //case.register)))
- (_.return bodyO))]]
+ (do {! ///////phase.monad}
+ [@scope (:: ! map ..@scope /////generation.next)
+ initsO+ (monad.map ! (expression archive) initsS+)
+ body! (/////generation.with-anchor [start @scope]
+ (statement expression archive bodyS))]
+ (wrap (..setup true start initsO+
+ (_.with-label (_.label @scope)
+ (_.do-while (_.boolean true)
+ body!)))))))
+
+(def: #export (scope statement expression archive [start initsS+ bodyS])
+ (-> Phase! (Generator (Scope Synthesis)))
+ (case initsS+
+ ## function/false/non-independent loop
+ #.Nil
+ (expression archive bodyS)
+
+ ## true loop
+ _
+ (do {! ///////phase.monad}
+ [@scope (:: ! map ..@scope /////generation.next)
+ initsO+ (monad.map ! (expression archive) initsS+)
+ body! (/////generation.with-anchor [start @scope]
+ (statement expression archive bodyS))
+ #let [closure (_.closure
+ (|> initsS+
+ list.enumerate
+ (list@map (|>> product.left (n.+ start) //case.register)))
+ (_.with-label (_.label @scope)
+ (_.do-while (_.boolean true)
+ body!)))]]
(wrap (_.apply/* closure initsO+)))))
-(def: #export (recur generate archive argsS+)
- (Generator (List Synthesis))
- (do {@ ///////phase.monad}
- [@scope /////generation.anchor
- argsO+ (monad.map @ (generate archive) argsS+)]
- (wrap (_.apply/* @scope argsO+))))
+(def: @temp (_.var "lux_recur_values"))
+
+(def: #export (recur! statement expression archive argsS+)
+ (Generator! (List Synthesis))
+ (do {! ///////phase.monad}
+ [[offset @scope] /////generation.anchor
+ argsO+ (monad.map ! (expression archive) argsS+)]
+ (wrap ($_ _.then
+ (_.define @temp (_.array argsO+))
+ (..setup false offset
+ (|> argsO+
+ list.enumerate
+ (list@map (function (_ [idx _])
+ (_.at (_.i32 (.int idx)) @temp))))
+ (_.continue-at (_.label @scope)))))))
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 9356f7f8d..7c18df1b9 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
@@ -24,10 +24,12 @@
["." /// #_
["#." reference]
["//#" /// #_
- ["#." synthesis]
+ ["#." synthesis (#+ Synthesis)]
["#." generation (#+ Buffer)]
["//#" /// (#+ Output)
["#." phase]
+ [reference
+ [variable (#+ Register)]]
[meta
[archive (#+ Archive)
["." artifact (#+ Registry)]]]]]]
@@ -35,7 +37,7 @@
(template [<name> <base>]
[(type: #export <name>
- (<base> Var Expression Statement))]
+ (<base> [Register Text] Expression Statement))]
[Operation /////generation.Operation]
[Phase /////generation.Phase]
@@ -43,6 +45,12 @@
[Bundle /////generation.Bundle]
)
+(type: #export Phase!
+ (-> Phase Archive Synthesis (Operation Statement)))
+
+(type: #export (Generator! i)
+ (-> Phase! Phase Archive i (Operation Statement)))
+
(type: #export (Generator i)
(-> Phase Archive i (Operation Expression)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
index 41153f29c..945a8d03c 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
@@ -18,12 +18,12 @@
[text
["%" format (#+ format)]]]
[target
- [jvm
+ ["." jvm #_
["_" bytecode (#+ Label Bytecode)]
["." modifier (#+ Modifier) ("#@." monoid)]
["." field (#+ Field)]
["." method (#+ Method)]
- ["." version]
+ ["#/." version]
["." class (#+ Class)]
["." constant
[pool (#+ Resource)]]
@@ -45,6 +45,7 @@
["#/." count]]]]]
["//#" /// #_
[//
+ ["." version]
["." synthesis]
["." generation]
[///
@@ -52,7 +53,7 @@
[arity (#+ Arity)]
[reference
[variable (#+ Register)]]
- ["." meta
+ [meta
[io (#+ lux-context)]
[archive (#+ Archive)]]]]]])
@@ -81,7 +82,7 @@
(def: #export (class-name [module id])
(-> generation.Context Text)
(format lux-context
- "/" (%.nat meta.version)
+ "/" (%.nat version.version)
"/" (%.nat module)
"/" (%.nat id)))
@@ -509,7 +510,7 @@
class.final))
bytecode (<| (format.run class.writer)
try.assume
- (class.class version.v6_0
+ (class.class jvm/version.v6_0
modifier
(name.internal class)
(name.internal (..reflection ^Object)) (list)
@@ -576,7 +577,7 @@
(row.row)))
bytecode (<| (format.run class.writer)
try.assume
- (class.class version.v6_0
+ (class.class jvm/version.v6_0
modifier
(name.internal class)
(name.internal (..reflection ^Object)) (list)
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 d2a4c21e0..a28e1918f 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
@@ -4,6 +4,7 @@
[text
["%" format (#+ format)]]]]
["." //// #_
+ ["." version]
["#." generation (#+ Context)]
["//#" /// #_
["." reference (#+ Reference)
@@ -14,7 +15,10 @@
(def: #export (artifact [module artifact])
(-> Context Text)
- (format "lux_" "m" (%.nat module) "a" (%.nat artifact)))
+ (format "lux_"
+ "v" (%.nat version.version)
+ "m" (%.nat module)
+ "a" (%.nat artifact)))
(signature: #export (System expression)
(: (-> Text expression)
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index 77d7b4689..216295d3f 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -74,7 +74,7 @@
(All [!] (-> (file.System !) Static Path))
(format (..unversioned-lux-archive system static)
(:: system separator)
- (%.nat ///.version)))
+ (%.nat version.version)))
(def: (module system static module-id)
(All [!] (-> (file.System !) Static archive.ID Path))
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
index f391e43a8..20756c0cf 100644
--- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux
+++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
@@ -72,7 +72,7 @@
{directive
so-far}
{directive
- (:assume artifact)})))))
+ (:assume content)})))))
so-far
artifacts))
diff --git a/stdlib/source/program/licentia.lux b/stdlib/source/program/licentia.lux
index 5021eb5bb..b3765916f 100644
--- a/stdlib/source/program/licentia.lux
+++ b/stdlib/source/program/licentia.lux
@@ -37,7 +37,7 @@
["#." input]
["#." output]])
-(with-expansions [<expiry> (as-is "2019-04-01")]
+(with-expansions [<expiry> "2019-04-01"]
(to-do <expiry> "Replace _.work with _.covered-work or _.licensed-work")
(to-do <expiry> "Create a short notice to add as a comment to each file in the _.work"))
@@ -64,6 +64,7 @@
json (|> raw-json
(:coerce java/lang/String)
java/lang/String::trim
+ (:coerce Text)
(:: json.codec decode))
license (json.run json /input.license)]
(wrap (/output.license license))))