diff options
Diffstat (limited to '')
6 files changed, 229 insertions, 204 deletions
diff --git a/commands.md b/commands.md index a1f3aea00..edfd16b66 100644 --- a/commands.md +++ b/commands.md @@ -181,7 +181,7 @@ cd ~/lux/lux-js/ && lein clean && lein lux auto build ## Try ``` -cd ~/lux/lux-js/ && 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-js/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux ``` --- diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 0b811a7b7..f162cc157 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -372,73 +372,73 @@ (:assume ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))})] (do (try.with promise.monad) - [#let [parallel-compiler (..parallel - context - (function (_ import! module-id [archive state] module) - (do (try.with promise.monad) - [#let [state (..set-current-module module state)] - input (context.read (get@ #&file-system platform) - import - compilation-sources - (get@ #static.host-module-extension static) - module)] - (loop [[archive state] [archive state] - compilation (base-compiler (:coerce ///.Input input)) - all-dependencies (: (List Module) - (list))] - (do {@ (try.with promise.monad)} - [#let [new-dependencies (get@ #///.dependencies compilation) - all-dependencies (list@compose new-dependencies all-dependencies) - continue! (:share [<type-vars>] - {<Platform> - platform} - {(-> <Context> (///.Compilation <State+> .Module Any) (List Module) - (Action [Archive <State+>])) - (:assume - recur)})] - [archive state] (case new-dependencies - #.Nil - (wrap [archive state]) + [#let [compiler (..parallel + context + (function (_ import! module-id [archive state] module) + (do (try.with promise.monad) + [#let [state (..set-current-module module state)] + input (context.read (get@ #&file-system platform) + import + compilation-sources + (get@ #static.host-module-extension static) + module)] + (loop [[archive state] [archive state] + compilation (base-compiler (:coerce ///.Input input)) + all-dependencies (: (List Module) + (list))] + (do {@ (try.with promise.monad)} + [#let [new-dependencies (get@ #///.dependencies compilation) + all-dependencies (list@compose new-dependencies all-dependencies) + continue! (:share [<type-vars>] + {<Platform> + platform} + {(-> <Context> (///.Compilation <State+> .Module Any) (List Module) + (Action [Archive <State+>])) + (:assume + recur)})] + [archive state] (case new-dependencies + #.Nil + (wrap [archive state]) - (#.Cons _) - (do @ - [archive,document+ (|> new-dependencies - (list@map import!) - (monad.seq ..monad)) - #let [archive (|> archive,document+ - (list@map product.left) - (list@fold archive.merge archive))]] - (wrap [archive (try.assume - (..updated-state archive state))])))] - (case ((get@ #///.process compilation) - ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP. - ## TODO: The context shouldn't need to be re-set either. - (|> (///directive.set-current-module module) - (///phase.run' state) - try.assume - product.left) - archive) - (#try.Success [state more|done]) - (case more|done - (#.Left more) - (continue! [archive state] more all-dependencies) + (#.Cons _) + (do @ + [archive,document+ (|> new-dependencies + (list@map import!) + (monad.seq ..monad)) + #let [archive (|> archive,document+ + (list@map product.left) + (list@fold archive.merge archive))]] + (wrap [archive (try.assume + (..updated-state archive state))])))] + (case ((get@ #///.process compilation) + ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP. + ## TODO: The context shouldn't need to be re-set either. + (|> (///directive.set-current-module module) + (///phase.run' state) + try.assume + product.left) + archive) + (#try.Success [state more|done]) + (case more|done + (#.Left more) + (continue! [archive state] more all-dependencies) - (#.Right [[descriptor document] output]) - (do (try.with promise.monad) - [#let [_ (log! (..module-compilation-log state)) - descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)] - _ (..cache-module static platform module-id [[descriptor document] output])] - (case (archive.add module [descriptor document] archive) - (#try.Success archive) - (wrap [archive - (..with-reset-log state)]) - - (#try.Failure error) - (promise@wrap (#try.Failure error))))) + (#.Right [[descriptor document] output]) + (do (try.with promise.monad) + [#let [_ (log! (..module-compilation-log state)) + descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)] + _ (..cache-module static platform module-id [[descriptor document] output])] + (case (archive.add module [descriptor document] archive) + (#try.Success archive) + (wrap [archive + (..with-reset-log state)]) + + (#try.Failure error) + (promise@wrap (#try.Failure error))))) - (#try.Failure error) - (do (try.with promise.monad) - [_ (ioW.freeze (get@ #&file-system platform) static archive)] - (promise@wrap (#try.Failure error)))))))))]] - (parallel-compiler compilation-module)))) + (#try.Failure error) + (do (try.with promise.monad) + [_ (ioW.freeze (get@ #&file-system platform) static archive)] + (promise@wrap (#try.Failure error)))))))))]] + (compiler compilation-module)))) )) 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 1dc91abe2..700411c5f 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 @@ -3,7 +3,7 @@ [abstract ["." monad (#+ do)]] [control - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)]] [data ["." maybe] ["." text] @@ -138,125 +138,145 @@ ..restore-cursor! post!))) -(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 +(def: (optimized-pattern-matching recur generate archive pathP) + (-> (-> Path (Operation Statement)) Phase Archive + (-> Path (Operation (Maybe Statement)))) + (.case pathP + (^template [<simple> <choice>] + (^ (<simple> idx nextP)) + (|> nextP + recur + (:: ///////phase.monad map (|>> (_.then (<choice> true idx)) #.Some)))) + ([/////synthesis.simple-left-side ..left-choice] + [/////synthesis.simple-right-side ..right-choice]) + + (^ (/////synthesis.member/left 0)) + (///////phase@wrap (#.Some (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! (recur thenP)] + (wrap (#.Some ($_ _.then + (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor)) + then!)))) + + ## Extra optimization + (^template [<pm> <getter>] (^ (/////synthesis.path/seq - (/////synthesis.member/left 0) + (<pm> lefts) (/////synthesis.!bind-top register thenP))) (do ///////phase.monad [then! (recur 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))) - - ## 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)) + (wrap (#.Some ($_ _.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! (recur thenP)] + (wrap (#.Some ($_ _.then + (_.define (..register register) ..peek-and-pop-cursor) + then!)))) + + (^ (/////synthesis.!multi-pop nextP)) + (.let [[extra-pops nextP'] (////synthesis/case.count-pops nextP)] (do ///////phase.monad - [then! (recur 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)] - (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])))) + [next! (recur nextP')] + (wrap (#.Some ($_ _.then + (multi-pop-cursor! (n.+ 2 extra-pops)) + next!))))) + + _ + (///////phase@wrap #.None))) + +(def: (pattern-matching' generate archive) + (-> Phase Archive + (-> Path (Operation Statement))) + (function (recur pathP) + (do ///////phase.monad + [outcome (optimized-pattern-matching recur generate archive pathP)] + (.case outcome + (#.Some outcome) + (wrap outcome) + + #.None + (.case pathP + #/////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]) + + (#/////synthesis.Then bodyS) + (do ///////phase.monad + [body! (generate archive bodyS)] + (wrap (_.return body!))) + + (^template [<complex> <choice>] + (^ (<complex> idx)) + (///////phase@wrap (<choice> false idx))) + ([/////synthesis.side/left ..left-choice] + [/////synthesis.side/right ..right-choice]) + + (^template [<pm> <getter>] + (^ (<pm> lefts)) + (///////phase@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor)))) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) + + (^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/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux index 01312ba83..096993996 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 @@ -24,16 +24,23 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (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))]] - (wrap (_.apply/* closure initsO+)))) + (case initsS+ + ## function/false/non-independent loop + #.Nil + (generate 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))]] + (wrap (_.apply/* closure initsO+))))) (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux index aa9d8f5a5..8fc87bcc2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -59,19 +59,17 @@ [locals /.locals] (wrap (|> functionS (//loop.optimization true locals argsS) - (maybe@map (: (-> Synthesis Synthesis) - (function (_ synthesis) - (case synthesis - (^ (<| /.loop/scope [start inits] - /.loop/scope [start' inits'] - output)) + (maybe@map (: (-> [Nat (List Synthesis) Synthesis] Synthesis) + (function (_ [start inits iteration]) + (case iteration + (^ (/.loop/scope [start' inits' output])) (if (and (n.= start start') (list.empty? inits')) (/.loop/scope [start inits output]) - synthesis) + (/.loop/scope [start inits iteration])) _ - synthesis)))) + (/.loop/scope [start inits iteration]))))) (maybe.default <apply>)))) (wrap <apply>)) @@ -274,10 +272,10 @@ (wrap (if currying? (/.function/abstraction abstraction) (case (//loop.optimization false 1 (list) abstraction) - (#.Some loop-body) + (#.Some [startL initsL bodyL]) (/.function/abstraction {#/.environment environment #/.arity (get@ #/.arity abstraction) - #/.body loop-body}) + #/.body (/.loop/scope [startL initsL bodyL])}) #.None (/.function/abstraction abstraction)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index ecd1889cb..e2e4e4db5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -198,7 +198,7 @@ (maybe@map (|>> [name] #/.Extension)))))) (def: #export (optimization true-loop? offset inits functionS) - (-> Bit Register (List Synthesis) Abstraction (Maybe Synthesis)) + (-> Bit Register (List Synthesis) Abstraction (Maybe [Register (List Synthesis) Synthesis])) (|> (get@ #/.body functionS) (body-optimization true-loop? offset (get@ #/.environment functionS) (get@ #/.arity functionS)) - (maybe@map (|>> [offset inits] /.loop/scope)))) + (maybe@map (|>> [offset inits])))) |