From 7ee04017ee2ef5376c566b00750fd521c0ecac42 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 14 Jun 2019 23:38:53 -0400 Subject: Some fixes for the scripting languages. + Small optimizations for pattern-matching generation.--- stdlib/source/lux/target/js.lux | 12 ++++--- stdlib/source/lux/tool/compiler/default/init.lux | 24 ++++--------- .../source/lux/tool/compiler/default/platform.lux | 8 +++-- .../phase/generation/common-lisp/runtime.lux | 4 +-- .../lux/tool/compiler/phase/generation/js/case.lux | 29 +++++++++++++--- .../phase/generation/js/extension/common.lux | 40 +++++++++------------- .../tool/compiler/phase/generation/js/runtime.lux | 8 ++--- .../tool/compiler/phase/generation/lua/runtime.lux | 4 +-- .../tool/compiler/phase/generation/php/runtime.lux | 4 +-- .../compiler/phase/generation/python/runtime.lux | 4 +-- .../compiler/phase/generation/ruby/runtime.lux | 4 +-- .../compiler/phase/generation/scheme/runtime.lux | 4 +-- stdlib/source/program/compositor.lux | 7 ++-- .../lux/tool/compiler/phase/analysis/primitive.lux | 3 +- 14 files changed, 83 insertions(+), 72 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/lux/target/js.lux b/stdlib/source/lux/target/js.lux index 756530817..c34f806f8 100644 --- a/stdlib/source/lux/target/js.lux +++ b/stdlib/source/lux/target/js.lux @@ -45,7 +45,7 @@ ) (template [ ] - [(def: #export Computation (|> ..argument :abstraction))] + [(def: #export Computation (:abstraction ))] [null "null"] [undefined "undefined"] @@ -106,9 +106,7 @@ (def: #export (at index array-or-object) (-> Expression Expression Access) - (|> (format (:representation array-or-object) (..element (:representation index))) - ..argument - :abstraction)) + (:abstraction (format (:representation array-or-object) (..element (:representation index))))) (def: #export (the field object) (-> Text Expression Access) @@ -138,7 +136,7 @@ (def: #export (, pre post) (-> Expression Expression Computation) - (|> (format (:representation pre) ", " (:representation post)) + (|> (format (:representation pre) ..argument-separator (:representation post)) ..argument :abstraction)) @@ -282,6 +280,10 @@ (-> Location Expression Statement) (:abstraction (format (:representation name) " = " (:representation value) ..statement-suffix))) + (def: #export (set' name value) + (-> Location Expression Expression) + (:abstraction (..argument (format (:representation name) " = " (:representation value))))) + (def: #export (throw message) (-> Expression Statement) (:abstraction (format "throw " (:representation message) ..statement-suffix))) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index 28c0efb76..1f650634f 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -1,7 +1,5 @@ (.module: [lux (#- Module) - ["@" target] - [type (#+ :share)] [abstract ["." monad (#+ do)]] [control @@ -44,24 +42,16 @@ ["." descriptor (#+ Module)] ["." document]]]]]) -(def: #export info - Info - {#.target (`` (for {(~~ (static @.common-lisp)) @.common-lisp - (~~ (static @.js)) @.js - (~~ (static @.old)) @.jvm - (~~ (static @.jvm)) @.jvm - (~~ (static @.lua)) @.lua - (~~ (static @.php)) @.php - (~~ (static @.python)) @.python - (~~ (static @.r)) @.r - (~~ (static @.ruby)) @.ruby - (~~ (static @.scheme)) @.scheme})) +(def: #export (info target) + (-> Text Info) + {#.target target #.version //.version #.mode #.Build}) -(def: #export (state expander host generate generation-bundle host-statement-bundle program) +(def: #export (state target expander host generate generation-bundle host-statement-bundle program) (All [anchor expression statement] - (-> Expander + (-> Text + Expander (generation.Host expression statement) (generation.Phase anchor expression statement) (generation.Bundle anchor expression statement) @@ -71,7 +61,7 @@ (let [synthesis-state [synthesisE.bundle ///synthesis.init] generation-state [generation-bundle (generation.state host)] eval (//evaluation.evaluator expander synthesis-state generation-state generate) - analysis-state [(analysisE.bundle eval) (///analysis.state ..info host)]] + analysis-state [(analysisE.bundle eval) (///analysis.state (..info target) host)]] [(dictionary.merge (luxS.bundle expander program) host-statement-bundle) {#///statement.analysis {#///statement.state analysis-state diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 10a27403e..5dc5105f2 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -56,9 +56,10 @@ (as-is (///statement.State+ anchor expression statement)) (as-is (generation.Bundle anchor expression statement))] - (def: #export (initialize expander platform generation-bundle host-statement-bundle program) + (def: #export (initialize target expander platform generation-bundle host-statement-bundle program) (All - (-> Expander + (-> Text + Expander (///statement.Bundle anchor expression statement) @@ -67,7 +68,8 @@ (|> platform (get@ #runtime) ///statement.lift-generation - (///phase.run' (//init.state expander + (///phase.run' (//init.state target + expander (get@ #host platform) (get@ #phase platform) generation-bundle diff --git a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux index 774844bdf..843db713d 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux @@ -171,9 +171,9 @@ (with-vars [last-index-right right-index] (_.let (list [last-index-right (..last-index tuple)] [right-index (_.+ (_.int +1) lefts)]) - (_.cond (list [(_.= right-index last-index-right) + (_.cond (list [(_.= last-index-right right-index) (_.elt/2 [tuple right-index])] - [(_.> right-index last-index-right) + [(_.> last-index-right right-index) ## Needs recursion. (!recur tuple//right)]) (_.subseq/3 [tuple right-index (_.length/1 tuple)])) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux index e1182c4b5..c2e0f667e 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux @@ -170,9 +170,29 @@ (^ (/////synthesis.member/left 0)) (////@wrap (push-cursor! (_.at (_.i32 +0) ..peek-cursor))) + ## Extra optimization + (^ (/////synthesis.path/seq + (/////synthesis.member/left 0) + (/////synthesis.!bind-top register thenP))) + (do ////.monad + [then! (pattern-matching' generate thenP)] + (////@wrap ($_ _.then + (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor)) + then!))) + (^template [ ] (^ ( lefts)) - (////@wrap (push-cursor! ( (_.i32 (.int lefts)) ..peek-cursor)))) + (////@wrap (push-cursor! ( (_.i32 (.int lefts)) ..peek-cursor))) + + ## Extra optimization + (^ (/////synthesis.path/seq + ( lefts) + (/////synthesis.!bind-top register thenP))) + (do ////.monad + [then! (pattern-matching' generate thenP)] + (////@wrap ($_ _.then + (_.define (..register register) ( (_.i32 (.int lefts)) ..peek-cursor)) + then!)))) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) @@ -200,20 +220,21 @@ ([/////synthesis.path/seq _.then] [/////synthesis.path/alt alternation]))) -(def: (pattern-matching generate pathP) - (-> Phase Path (Operation Statement)) +(def: (pattern-matching stack-init generate pathP) + (-> Expression Phase Path (Operation Statement)) (do ////.monad [pattern-matching! (pattern-matching' generate pathP)] (wrap ($_ _.then (_.do-while _.false pattern-matching!) + (_.statement (//runtime.io//log stack-init)) (_.throw (_.string case.pattern-matching-error)))))) (def: #export (case generate [valueS pathP]) (-> Phase [Synthesis Path] (Operation Computation)) (do ////.monad [stack-init (generate valueS) - path! (pattern-matching generate pathP) + path! (pattern-matching stack-init generate pathP) #let [closure (<| (_.closure (list)) ($_ _.then (_.declare @temp) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux index 5253ffe19..c9dc64547 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux @@ -41,12 +41,12 @@ (Nullary Expression) (///primitive.f64 ))] - [frac//smallest (java/lang/Double::MIN_VALUE)] - [frac//min (f/* -1.0 (java/lang/Double::MAX_VALUE))] - [frac//max (java/lang/Double::MAX_VALUE)] + [f64//smallest (java/lang/Double::MIN_VALUE)] + [f64//min (f/* -1.0 (java/lang/Double::MAX_VALUE))] + [f64//max (java/lang/Double::MAX_VALUE)] ) -(def: frac//decode +(def: f64//decode (Unary Expression) (|>> list (_.apply/* (_.var "parseFloat")) @@ -54,7 +54,7 @@ (_.closure (list)) ///runtime.lux//try)) -(def: int//char +(def: i64//char (Unary Expression) (|>> ///runtime.i64//to-number (list) @@ -117,24 +117,19 @@ (bundle.install "logical-right-shift" (binary i64//logical-right-shift)) (bundle.install "arithmetic-right-shift" (binary i64//arithmetic-right-shift)) (bundle.install "=" (binary (product.uncurry ///runtime.i64//=))) + (bundle.install "<" (binary (product.uncurry ///runtime.i64//<))) (bundle.install "+" (binary (product.uncurry ///runtime.i64//+))) (bundle.install "-" (binary (product.uncurry ///runtime.i64//-))) - ))) - -(def: int-procs - Bundle - (<| (bundle.prefix "int") - (|> bundle.empty - (bundle.install "<" (binary (product.uncurry ///runtime.i64//<))) (bundle.install "*" (binary (product.uncurry ///runtime.i64//*))) (bundle.install "/" (binary (product.uncurry ///runtime.i64///))) (bundle.install "%" (binary (product.uncurry ///runtime.i64//%))) - (bundle.install "frac" (unary ///runtime.i64//to-number)) - (bundle.install "char" (unary int//char))))) + (bundle.install "f64" (unary ///runtime.i64//to-number)) + (bundle.install "char" (unary i64//char)) + ))) -(def: frac-procs +(def: f64-procs Bundle - (<| (bundle.prefix "frac") + (<| (bundle.prefix "f64") (|> bundle.empty (bundle.install "+" (binary (product.uncurry _.+))) (bundle.install "-" (binary (product.uncurry _.-))) @@ -143,12 +138,12 @@ (bundle.install "%" (binary (product.uncurry _.%))) (bundle.install "=" (binary (product.uncurry _.=))) (bundle.install "<" (binary (product.uncurry _.<))) - (bundle.install "smallest" (nullary frac//smallest)) - (bundle.install "min" (nullary frac//min)) - (bundle.install "max" (nullary frac//max)) - (bundle.install "int" (unary ///runtime.i64//from-number)) + (bundle.install "smallest" (nullary f64//smallest)) + (bundle.install "min" (nullary f64//min)) + (bundle.install "max" (nullary f64//max)) + (bundle.install "i64" (unary ///runtime.i64//from-number)) (bundle.install "encode" (unary (_.do "toString" (list)))) - (bundle.install "decode" (unary frac//decode))))) + (bundle.install "decode" (unary f64//decode))))) (def: text-procs Bundle @@ -177,8 +172,7 @@ (<| (bundle.prefix "lux") (|> lux-procs (dictionary.merge i64-procs) - (dictionary.merge int-procs) - (dictionary.merge frac-procs) + (dictionary.merge f64-procs) (dictionary.merge text-procs) (dictionary.merge io-procs) ))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux index ea42f44e2..6892879b8 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux @@ -198,9 +198,9 @@ ($_ _.then (_.define last-index-right (..last-index tuple)) (_.define right-index (_.+ (_.i32 +1) lefts)) - (_.cond (list [(_.= right-index last-index-right) + (_.cond (list [(_.= last-index-right right-index) (_.return (_.at right-index tuple))] - [(_.> right-index last-index-right) + [(_.> last-index-right right-index) ## Needs recursion. ]) (_.return (_.do "slice" (list right-index) tuple))) @@ -634,8 +634,8 @@ ($_ _.then (_.define result (|> text (_.do "charCodeAt" (list (_.the ..i64-low-field idx))))) (_.if (_.not-a-number? result) - (_.return ..none) - (_.return (..some (i64//from-number result))))))) + (_.throw (_.string "[Lux Error] Cannot get char from text.")) + (_.return (i64//from-number result)))))) (def: runtime//text Statement diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux index 602897f1b..e5ce5a201 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux @@ -167,9 +167,9 @@ ($_ _.then (_.let (list last-right) (..last-index tuple)) (_.let (list right-index) (_.+ (_.int +1) lefts)) - (_.cond (list [(_.= right-index last-right) + (_.cond (list [(_.= last-right right-index) (_.return (..nth right-index tuple))] - [(_.> right-index last-right) + [(_.> last-right right-index) ## Needs recursion. (_.return (tuple//right (_.- last-right lefts) (..nth last-right tuple)))]) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux index b67f4d20a..a5a22917e 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux @@ -199,9 +199,9 @@ ($_ _.then (_.; (_.set last-index-right (..last-index tuple))) (_.; (_.set right-index (_.+ (_.int +1) lefts))) - (_.cond (list [(_.= right-index last-index-right) + (_.cond (list [(_.= last-index-right right-index) (_.return (_.nth right-index tuple))] - [(_.> right-index last-index-right) + [(_.> last-index-right right-index) ## Needs recursion. ]) (_.return (_.array-slice/2 [tuple right-index]))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux index e04befc25..3fd58ef1b 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux @@ -204,9 +204,9 @@ ($_ _.then (_.set (list last-index-right) (..last-index tuple)) (_.set (list right-index) (_.+ (_.int +1) lefts)) - (_.cond (list [(_.= right-index last-index-right) + (_.cond (list [(_.= last-index-right right-index) (_.return (_.nth right-index tuple))] - [(_.> right-index last-index-right) + [(_.> last-index-right right-index) ## Needs recursion. ]) (_.return (_.slice-from right-index tuple))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux index 99c6ef38a..f0d88923e 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux @@ -156,9 +156,9 @@ ($_ _.then (_.set (list last-index-right) (..last-index tuple)) (_.set (list right-index) (_.+ (_.int +1) lefts)) - (_.cond (list [(_.= right-index last-index-right) + (_.cond (list [(_.= last-index-right right-index) (_.return (_.nth right-index tuple))] - [(_.> right-index last-index-right) + [(_.> last-index-right right-index) ## Needs recursion. ]) (_.return (_.array-range right-index (..tuple-size tuple) tuple))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux index 94269b4aa..7d55f0faf 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux @@ -173,9 +173,9 @@ (_.begin (list (_.define-constant last-index-right (..last-index tuple)) (_.define-constant right-index (_.+/2 (_.int +1) lefts)) - (_.cond (list [(_.=/2 right-index last-index-right) + (_.cond (list [(_.=/2 last-index-right right-index) (_.vector-ref/2 tuple right-index)] - [(_.>/2 right-index last-index-right) + [(_.>/2 last-index-right right-index) ## Needs recursion. (tuple//right (_.-/2 last-index-right lefts) (_.vector-ref/2 tuple last-index-right))]) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 7d058ec0e..7db076162 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -78,9 +78,10 @@ (#error.Failure error) (:: io.monad wrap (#error.Failure error))))) -(def: #export (compiler expander platform generation-bundle host-statement-bundle program service) +(def: #export (compiler target expander platform generation-bundle host-statement-bundle program service) (All [anchor expression statement] - (-> Expander + (-> Text + Expander (IO (Platform IO anchor expression statement)) (generation.Bundle anchor expression statement) (statement.Bundle anchor expression statement) @@ -98,7 +99,7 @@ {(Platform IO anchor expression statement) platform} {(IO (Error (statement.State+ anchor expression statement))) - (platform.initialize expander platform generation-bundle host-statement-bundle program)}) + (platform.initialize target expander platform generation-bundle host-statement-bundle program)}) [archive state] (:share [anchor expression statement] {(Platform IO anchor expression statement) platform} diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux index 2ed135058..8291794d5 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux @@ -1,5 +1,6 @@ (.module: [lux (#- primitive) + ["@" target] [abstract ["." monad (#+ do)]] [data text/format @@ -43,7 +44,7 @@ (def: #export state ////analysis.State+ - [(///analysis.bundle ..eval) (////analysis.state init.info [])]) + [(///analysis.bundle ..eval) (////analysis.state (init.info @.jvm) [])]) (def: #export primitive (Random [Type Code]) -- cgit v1.2.3