diff options
Diffstat (limited to '')
15 files changed, 329 insertions, 211 deletions
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)))) |