diff options
Diffstat (limited to 'stdlib/source')
17 files changed, 360 insertions, 301 deletions
diff --git a/stdlib/source/lux/abstract/algebra.lux b/stdlib/source/lux/abstract/algebra.lux index 2813ed0e7..0d066fb4f 100644 --- a/stdlib/source/lux/abstract/algebra.lux +++ b/stdlib/source/lux/abstract/algebra.lux @@ -3,7 +3,6 @@ [control functor]]) -## Types (type: #export (Algebra f a) (-> (f a) a)) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 60d57abab..c42093710 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -51,6 +51,10 @@ [Object (Dictionary String JSON)] ) +(def: #export object + (-> (List [String JSON]) JSON) + (|>> (dictionary.from-list text.hash) #..Object)) + (syntax: #export (json token) {#.doc (doc "A simple way to produce JSON literals." (json #1) @@ -66,15 +70,15 @@ (^template [<ast-tag> <ctor> <json-tag>] [_ (<ast-tag> value)] (wrap (list (` (: JSON (<json-tag> (~ (<ctor> value)))))))) - ([#.Bit code.bit #Boolean] - [#.Frac code.frac #Number] - [#.Text code.text #String]) + ([#.Bit code.bit #..Boolean] + [#.Frac code.frac #..Number] + [#.Text code.text #..String]) [_ (#.Tag ["" "null"])] - (wrap (list (` (: JSON #Null)))) + (wrap (list (` (: JSON #..Null)))) [_ (#.Tuple members)] - (wrap (list (` (: JSON (#Array ((~! row) (~+ (list@map wrapper members)))))))) + (wrap (list (` (: JSON (#..Array ((~! row) (~+ (list@map wrapper members)))))))) [_ (#.Record pairs)] (do ..monad @@ -87,7 +91,9 @@ _ (macro.fail "Wrong syntax for JSON object."))) pairs)] - (wrap (list (` (: JSON (#Object ((~! dictionary.from-list) (~! text.hash) (list (~+ pairs'))))))))) + (wrap (list (` (: JSON (#..Object ((~! dictionary.from-list) + (~! text.hash) + (list (~+ pairs'))))))))) _ (wrap (list token))))) @@ -115,7 +121,7 @@ (#try.Failure ($_ text@compose "Missing field '" key "' on object."))) _ - (#try.Failure ($_ text@compose "Cannot get field '" key "' of a non-object.")))) + (#try.Failure ($_ text@compose "Cannot get field '" key "' on a non-object.")))) (def: #export (set key value json) {#.doc "A JSON object field setter."} @@ -125,7 +131,7 @@ (#try.Success (#Object (dictionary.put key value obj))) _ - (#try.Failure ($_ text@compose "Cannot set field '" key "' of a non-object.")))) + (#try.Failure ($_ text@compose "Cannot set field '" key "' on a non-object.")))) (template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js.lux new file mode 100644 index 000000000..81d2fe57b --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js.lux @@ -0,0 +1,17 @@ +(.module: + [lux #* + [data + [collection + ["." dictionary]]]] + ["." / #_ + ["#." common] + ["#." host] + [//// + [generation + [js + [runtime (#+ Bundle)]]]]]) + +(def: #export bundle + Bundle + (dictionary.merge /common.bundle + /host.bundle)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index c5c4d15ff..966815a29 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -16,17 +16,20 @@ ["." dictionary]]] [target ["_" js (#+ Literal Expression Statement)]]] - ["." /// #_ - ["#." runtime (#+ Operation Phase Handler Bundle)] - ["#." primitive] + ["." //// #_ + ["/" bundle] ["/#" // #_ - [extension (#+ Nullary Unary Binary Trinary - nullary unary binary trinary)] - ["/#" // - ["." extension - ["." bundle]] - [// - [synthesis (#+ %synthesis)]]]]]) + ["." extension] + [generation + [extension (#+ Nullary Unary Binary Trinary + nullary unary binary trinary)] + ["//" js #_ + ["#." runtime (#+ Operation Phase Handler Bundle)] + ["#." primitive]]] + [// + [synthesis (#+ %synthesis)] + [/// + ["#" phase]]]]]) (def: #export (custom [parser handler]) (All [s] @@ -46,11 +49,11 @@ (template [<name> <op>] [(def: (<name> [paramG subjectG]) (Binary Expression) - (<op> subjectG (///runtime.i64//to-number paramG)))] + (<op> subjectG (//runtime.i64//to-number paramG)))] - [i64//left-shift ///runtime.i64//left-shift] - [i64//arithmetic-right-shift ///runtime.i64//arithmetic-right-shift] - [i64//logical-right-shift ///runtime.i64//logic-right-shift] + [i64//left-shift //runtime.i64//left-shift] + [i64//arithmetic-right-shift //runtime.i64//arithmetic-right-shift] + [i64//logical-right-shift //runtime.i64//logic-right-shift] ) ## [[Numbers]] @@ -61,7 +64,7 @@ (template [<name> <const>] [(def: (<name> _) (Nullary Expression) - (///primitive.f64 <const>))] + (//primitive.f64 <const>))] [f64//smallest (java/lang/Double::MIN_VALUE)] [f64//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] @@ -74,11 +77,11 @@ (_.apply/* (_.var "parseFloat")) _.return (_.closure (list)) - ///runtime.lux//try)) + //runtime.lux//try)) (def: i64//char (Unary Expression) - (|>> ///runtime.i64//to-number + (|>> //runtime.i64//to-number (list) (_.apply/* (_.var "String.fromCharCode")))) @@ -89,18 +92,18 @@ (def: (text//clip [startG endG subjectG]) (Trinary Expression) - (///runtime.text//clip startG endG subjectG)) + (//runtime.text//clip startG endG subjectG)) (def: (text//index [startG partG subjectG]) (Trinary Expression) - (///runtime.text//index startG partG subjectG)) + (//runtime.text//index startG partG subjectG)) ## [[IO]] (def: (io//log messageG) (Unary Expression) ($_ _., - (///runtime.io//log messageG) - ///runtime.unit)) + (//runtime.io//log messageG) + //runtime.unit)) (def: (io//exit codeG) (Unary Expression) @@ -111,7 +114,7 @@ ($_ _.and (_.not (_.= _.undefined (_.type-of @@process))) (_.the "exit" @@process) - (_.do "exit" (list (///runtime.i64//to-number codeG)) @@process)) + (_.do "exit" (list (//runtime.i64//to-number codeG)) @@process)) (_.do "close" (list) @@window) (_.do "reload" (list) @@location)))) @@ -119,7 +122,7 @@ (Nullary Expression) (|> (_.new (_.var "Date") (list)) (_.do "getTime" (list)) - ///runtime.i64//from-number)) + //runtime.i64//from-number)) ## TODO: Get rid of this ASAP (def: lux::syntax-char-case! @@ -142,7 +145,7 @@ (_.return branchG)]))) conditionals))] (wrap (_.apply/* (_.closure (list) - (_.switch (_.the ///runtime.i64-low-field inputG) + (_.switch (_.the //runtime.i64-low-field inputG) conditionalsG (#.Some (_.return elseG)))) (list)))))])) @@ -150,75 +153,75 @@ ## [Bundles] (def: lux-procs Bundle - (|> bundle.empty - (bundle.install "syntax char case!" lux::syntax-char-case!) - (bundle.install "is" (binary (product.uncurry _.=))) - (bundle.install "try" (unary ///runtime.lux//try)))) + (|> /.empty + (/.install "syntax char case!" lux::syntax-char-case!) + (/.install "is" (binary (product.uncurry _.=))) + (/.install "try" (unary //runtime.lux//try)))) (def: i64-procs Bundle - (<| (bundle.prefix "i64") - (|> bundle.empty - (bundle.install "and" (binary (product.uncurry ///runtime.i64//and))) - (bundle.install "or" (binary (product.uncurry ///runtime.i64//or))) - (bundle.install "xor" (binary (product.uncurry ///runtime.i64//xor))) - (bundle.install "left-shift" (binary i64//left-shift)) - (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//-))) - (bundle.install "*" (binary (product.uncurry ///runtime.i64//*))) - (bundle.install "/" (binary (product.uncurry ///runtime.i64///))) - (bundle.install "%" (binary (product.uncurry ///runtime.i64//%))) - (bundle.install "f64" (unary ///runtime.i64//to-number)) - (bundle.install "char" (unary i64//char)) + (<| (/.prefix "i64") + (|> /.empty + (/.install "and" (binary (product.uncurry //runtime.i64//and))) + (/.install "or" (binary (product.uncurry //runtime.i64//or))) + (/.install "xor" (binary (product.uncurry //runtime.i64//xor))) + (/.install "left-shift" (binary i64//left-shift)) + (/.install "logical-right-shift" (binary i64//logical-right-shift)) + (/.install "arithmetic-right-shift" (binary i64//arithmetic-right-shift)) + (/.install "=" (binary (product.uncurry //runtime.i64//=))) + (/.install "<" (binary (product.uncurry //runtime.i64//<))) + (/.install "+" (binary (product.uncurry //runtime.i64//+))) + (/.install "-" (binary (product.uncurry //runtime.i64//-))) + (/.install "*" (binary (product.uncurry //runtime.i64//*))) + (/.install "/" (binary (product.uncurry //runtime.i64///))) + (/.install "%" (binary (product.uncurry //runtime.i64//%))) + (/.install "f64" (unary //runtime.i64//to-number)) + (/.install "char" (unary i64//char)) ))) (def: f64-procs Bundle - (<| (bundle.prefix "f64") - (|> bundle.empty - (bundle.install "+" (binary (product.uncurry _.+))) - (bundle.install "-" (binary (product.uncurry _.-))) - (bundle.install "*" (binary (product.uncurry _.*))) - (bundle.install "/" (binary (product.uncurry _./))) - (bundle.install "%" (binary (product.uncurry _.%))) - (bundle.install "=" (binary (product.uncurry _.=))) - (bundle.install "<" (binary (product.uncurry _.<))) - (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 f64//decode))))) + (<| (/.prefix "f64") + (|> /.empty + (/.install "+" (binary (product.uncurry _.+))) + (/.install "-" (binary (product.uncurry _.-))) + (/.install "*" (binary (product.uncurry _.*))) + (/.install "/" (binary (product.uncurry _./))) + (/.install "%" (binary (product.uncurry _.%))) + (/.install "=" (binary (product.uncurry _.=))) + (/.install "<" (binary (product.uncurry _.<))) + (/.install "smallest" (nullary f64//smallest)) + (/.install "min" (nullary f64//min)) + (/.install "max" (nullary f64//max)) + (/.install "i64" (unary //runtime.i64//from-number)) + (/.install "encode" (unary (_.do "toString" (list)))) + (/.install "decode" (unary f64//decode))))) (def: text-procs Bundle - (<| (bundle.prefix "text") - (|> bundle.empty - (bundle.install "=" (binary (product.uncurry _.=))) - (bundle.install "<" (binary (product.uncurry _.<))) - (bundle.install "concat" (binary text//concat)) - (bundle.install "index" (trinary text//index)) - (bundle.install "size" (unary (|>> (_.the "length") ///runtime.i64//from-number))) - (bundle.install "char" (binary (product.uncurry ///runtime.text//char))) - (bundle.install "clip" (trinary text//clip)) + (<| (/.prefix "text") + (|> /.empty + (/.install "=" (binary (product.uncurry _.=))) + (/.install "<" (binary (product.uncurry _.<))) + (/.install "concat" (binary text//concat)) + (/.install "index" (trinary text//index)) + (/.install "size" (unary (|>> (_.the "length") //runtime.i64//from-number))) + (/.install "char" (binary (product.uncurry //runtime.text//char))) + (/.install "clip" (trinary text//clip)) ))) (def: io-procs Bundle - (<| (bundle.prefix "io") - (|> bundle.empty - (bundle.install "log" (unary io//log)) - (bundle.install "error" (unary ///runtime.io//error)) - (bundle.install "exit" (unary io//exit)) - (bundle.install "current-time" (nullary io//current-time))))) + (<| (/.prefix "io") + (|> /.empty + (/.install "log" (unary io//log)) + (/.install "error" (unary //runtime.io//error)) + (/.install "exit" (unary io//exit)) + (/.install "current-time" (nullary io//current-time))))) (def: #export bundle Bundle - (<| (bundle.prefix "lux") + (<| (/.prefix "lux") (|> lux-procs (dictionary.merge i64-procs) (dictionary.merge f64-procs) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux index c44e1bdff..592446e93 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux @@ -13,24 +13,26 @@ ["_" js (#+ Expression)]]] ["." // #_ ["#." common (#+ custom)] - ["/#" // #_ - ["#." runtime (#+ Operation Phase Handler Bundle - with-vars)] - ["#." primitive] + ["//#" /// #_ + ["/" bundle] ["/#" // #_ - [extension (#+ Nullary Unary Binary Trinary - nullary unary binary trinary)] - ["/#" // - ["." extension - ["." bundle]]]]]]) + ["." extension] + [generation + [extension (#+ Nullary Unary Binary Trinary + nullary unary binary trinary)] + ["//" js #_ + ["#." runtime (#+ Operation Phase Handler Bundle + with-vars)]]] + ["///#" //// #_ + ["#." phase]]]]]) (def: array::new (Unary Expression) - (|>> ///runtime.i64//to-number list (_.new (_.var "Array")))) + (|>> //runtime.i64//to-number list (_.new (_.var "Array")))) (def: array::length (Unary Expression) - (|>> (_.the "length") ///runtime.i64//from-number)) + (|>> (_.the "length") //runtime.i64//from-number)) (def: (array::read [indexG arrayG]) (Binary Expression) @@ -38,28 +40,28 @@ (def: (array::write [indexG valueG arrayG]) (Trinary Expression) - (///runtime.array//write indexG valueG arrayG)) + (//runtime.array//write indexG valueG arrayG)) (def: (array::delete [indexG arrayG]) (Binary Expression) - (///runtime.array//delete indexG arrayG)) + (//runtime.array//delete indexG arrayG)) (def: array Bundle - (<| (bundle.prefix "array") - (|> bundle.empty - (bundle.install "new" (unary array::new)) - (bundle.install "length" (unary array::length)) - (bundle.install "read" (binary array::read)) - (bundle.install "write" (trinary array::write)) - (bundle.install "delete" (binary array::delete)) + (<| (/.prefix "array") + (|> /.empty + (/.install "new" (unary array::new)) + (/.install "length" (unary array::length)) + (/.install "read" (binary array::read)) + (/.install "write" (trinary array::write)) + (/.install "delete" (binary array::delete)) ))) (def: object::new (custom [($_ <>.and <s>.any (<>.some <s>.any)) (function (_ extension phase [constructorS inputsS]) - (do /////.monad + (do ////////phase.monad [constructorG (phase constructorS) inputsG (monad.map @ phase inputsS)] (wrap (_.new constructorG inputsG))))])) @@ -69,7 +71,7 @@ (custom [($_ <>.and <s>.text <s>.any) (function (_ extension phase [fieldS objectS]) - (do /////.monad + (do ////////phase.monad [objectG (phase objectS)] (wrap (_.the fieldS objectG))))])) @@ -78,7 +80,7 @@ (custom [($_ <>.and <s>.text <s>.any (<>.some <s>.any)) (function (_ extension phase [methodS objectS inputsS]) - (do /////.monad + (do ////////phase.monad [objectG (phase objectS) inputsG (monad.map @ phase inputsS)] (wrap (_.do methodS inputsG objectG))))])) @@ -93,22 +95,22 @@ (def: object Bundle - (<| (bundle.prefix "object") - (|> bundle.empty - (bundle.install "new" object::new) - (bundle.install "get" object::get) - (bundle.install "do" object::do) - (bundle.install "null" (nullary object::null)) - (bundle.install "null?" (unary object::null?)) - (bundle.install "undefined" (nullary object::undefined)) - (bundle.install "undefined?" (unary object::undefined?)) + (<| (/.prefix "object") + (|> /.empty + (/.install "new" object::new) + (/.install "get" object::get) + (/.install "do" object::do) + (/.install "null" (nullary object::null)) + (/.install "null?" (unary object::null?)) + (/.install "undefined" (nullary object::undefined)) + (/.install "undefined?" (unary object::undefined?)) ))) (def: js::constant (custom [<s>.text (function (_ extension phase name) - (do /////.monad + (do ////////phase.monad [] (wrap (_.var name))))])) @@ -116,18 +118,18 @@ (custom [($_ <>.and <s>.any (<>.some <s>.any)) (function (_ extension phase [abstractionS inputsS]) - (do /////.monad + (do ////////phase.monad [abstractionG (phase abstractionS) inputsG (monad.map @ phase inputsS)] (wrap (_.apply/* abstractionG inputsG))))])) (def: #export bundle Bundle - (<| (bundle.prefix "js") - (|> bundle.empty - (bundle.install "constant" js::constant) - (bundle.install "apply" js::apply) - (bundle.install "type-of" (unary _.type-of)) + (<| (/.prefix "js") + (|> /.empty + (/.install "constant" js::constant) + (/.install "apply" js::apply) + (/.install "type-of" (unary _.type-of)) (dictionary.merge ..array) (dictionary.merge ..object) ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux index c0cd734b3..ebfbda2a0 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 @@ -2,60 +2,63 @@ [lux #* [abstract [monad (#+ do)]]] - [/ + ["." / #_ [runtime (#+ Phase)] - ["." primitive] - ["." structure] - ["." reference ("#@." system)] - ["." function] - ["." case] - ["." loop] - ["." /// + ["#." primitive] + ["#." structure] + ["#." reference ("#@." system)] + ["#." case] + ["#." loop] + ["#." function] + ["//#" /// #_ ["." extension] - [// + ["/#" // #_ [analysis (#+)] - ["." synthesis]]]]) + ["." synthesis] + ["//#" /// #_ + ["#." phase ("#@." monad)]]]]]) (def: #export (generate synthesis) Phase (case synthesis (^template [<tag> <generator>] (^ (<tag> value)) - (:: ///.monad wrap (<generator> value))) - ([synthesis.bit primitive.bit] - [synthesis.i64 primitive.i64] - [synthesis.f64 primitive.f64] - [synthesis.text primitive.text]) + (//////phase@wrap (<generator> value))) + ([synthesis.bit /primitive.bit] + [synthesis.i64 /primitive.i64] + [synthesis.f64 /primitive.f64] + [synthesis.text /primitive.text]) (^ (synthesis.variant variantS)) - (structure.variant generate variantS) + (/structure.variant generate variantS) (^ (synthesis.tuple members)) - (structure.tuple generate members) + (/structure.tuple generate members) (#synthesis.Reference value) - (reference@reference value) + (/reference@reference value) (^ (synthesis.branch/case case)) - (case.case generate case) + (/case.case generate case) (^ (synthesis.branch/let let)) - (case.let generate let) + (/case.let generate let) (^ (synthesis.branch/if if)) - (case.if generate if) + (/case.if generate if) (^ (synthesis.loop/scope scope)) - (loop.scope generate scope) + (/loop.scope generate scope) (^ (synthesis.loop/recur updates)) - (loop.recur generate updates) + (/loop.recur generate updates) (^ (synthesis.function/abstraction abstraction)) - (function.function generate abstraction) + (/function.function generate abstraction) (^ (synthesis.function/apply application)) - (function.apply generate application) + (/function.apply generate application) (#synthesis.Extension extension) - (extension.apply generate extension))) + (extension.apply generate extension) + )) 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 d9956579c..79b63ba13 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 @@ -16,14 +16,16 @@ ["#." runtime (#+ Operation Phase)] ["#." reference] ["#." primitive] - ["#/" // #_ + ["/#" // #_ ["#." reference] - ["#/" // ("#@." monad) - [synthesis - ["." case]] - ["#/" // #_ - [reference (#+ Register)] - ["#." synthesis (#+ Synthesis Path)]]]]]) + ["/#" // #_ + ["#." synthesis #_ + ["#/." case]] + ["/#" // #_ + ["#." synthesis (#+ Synthesis Path)] + ["//#" /// #_ + [reference (#+ Register)] + ["#." phase ("#@." monad)]]]]]]) (def: #export register (///reference.local _.var)) @@ -31,7 +33,7 @@ (def: #export (let generate [valueS register bodyS]) (-> Phase [Synthesis Register Synthesis] (Operation Computation)) - (do ////.monad + (do ///////phase.monad [valueO (generate valueS) bodyO (generate bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. @@ -42,7 +44,7 @@ (def: #export (record-get generate valueS pathP) (-> Phase Synthesis (List (Either Nat Nat)) (Operation Expression)) - (do ////.monad + (do ///////phase.monad [valueO (generate valueS)] (wrap (list@fold (function (_ side source) (.let [method (.case side @@ -58,7 +60,7 @@ (def: #export (if generate [testS thenS elseS]) (-> Phase [Synthesis Synthesis Synthesis] (Operation Computation)) - (do ////.monad + (do ///////phase.monad [testO (generate testS) thenO (generate thenS) elseO (generate elseS)] @@ -138,20 +140,20 @@ (-> Phase Path (Operation Statement)) (.case pathP (^ (/////synthesis.path/then bodyS)) - (do ////.monad + (do ///////phase.monad [body! (generate bodyS)] (wrap (_.return body!))) #/////synthesis.Pop - (////@wrap pop-cursor!) + (///////phase@wrap pop-cursor!) (#/////synthesis.Bind register) - (////@wrap (_.define (..register register) ..peek-cursor)) + (///////phase@wrap (_.define (..register register) ..peek-cursor)) (^template [<tag> <format> <=>] (^ (<tag> value)) - (////@wrap (_.when (|> value <format> (<=> ..peek-cursor) _.not) - fail-pm!))) + (///////phase@wrap (_.when (|> value <format> (<=> ..peek-cursor) _.not) + fail-pm!))) ([/////synthesis.path/bit //primitive.bit _.=] [/////synthesis.path/i64 (<| //primitive.i64 .int) //runtime.i64//=] [/////synthesis.path/f64 //primitive.f64 _.=] @@ -159,62 +161,62 @@ (^template [<complex> <simple> <choice>] (^ (<complex> idx)) - (////@wrap (<choice> false idx)) + (///////phase@wrap (<choice> false idx)) (^ (<simple> idx nextP)) (|> nextP (pattern-matching' generate) - (:: ////.monad map (_.then (<choice> true idx))))) + (:: ///////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)) - (////@wrap (push-cursor! (_.at (_.i32 +0) ..peek-cursor))) + (///////phase@wrap (push-cursor! (_.at (_.i32 +0) ..peek-cursor))) ## Extra optimization (^ (/////synthesis.path/seq (/////synthesis.member/left 0) (/////synthesis.!bind-top register thenP))) - (do ////.monad + (do ///////phase.monad [then! (pattern-matching' generate thenP)] - (////@wrap ($_ _.then - (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor)) - then!))) + (///////phase@wrap ($_ _.then + (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor)) + then!))) (^template [<pm> <getter>] (^ (<pm> lefts)) - (////@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor))) + (///////phase@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor))) ## Extra optimization (^ (/////synthesis.path/seq (<pm> lefts) (/////synthesis.!bind-top register thenP))) - (do ////.monad + (do ///////phase.monad [then! (pattern-matching' generate thenP)] - (////@wrap ($_ _.then - (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor)) - then!)))) + (///////phase@wrap ($_ _.then + (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor)) + then!)))) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (^ (/////synthesis.!bind-top register thenP)) - (do ////.monad + (do ///////phase.monad [then! (pattern-matching' generate thenP)] - (////@wrap ($_ _.then - (_.define (..register register) ..peek-and-pop-cursor) - then!))) + (///////phase@wrap ($_ _.then + (_.define (..register register) ..peek-and-pop-cursor) + then!))) (^ (/////synthesis.!multi-pop nextP)) - (.let [[extra-pops nextP'] (case.count-pops nextP)] - (do ////.monad + (.let [[extra-pops nextP'] (////synthesis/case.count-pops nextP)] + (do ///////phase.monad [next! (pattern-matching' generate nextP')] - (////@wrap ($_ _.then - (multi-pop-cursor! (n.+ 2 extra-pops)) - next!)))) + (///////phase@wrap ($_ _.then + (multi-pop-cursor! (n.+ 2 extra-pops)) + next!)))) (^template [<tag> <combinator>] (^ (<tag> leftP rightP)) - (do ////.monad + (do ///////phase.monad [left! (pattern-matching' generate leftP) right! (pattern-matching' generate rightP)] (wrap (<combinator> left! right!)))) @@ -223,16 +225,16 @@ (def: (pattern-matching generate pathP) (-> Phase Path (Operation Statement)) - (do ////.monad + (do ///////phase.monad [pattern-matching! (pattern-matching' generate pathP)] (wrap ($_ _.then (_.do-while (_.boolean false) pattern-matching!) - (_.throw (_.string case.pattern-matching-error)))))) + (_.throw (_.string ////synthesis/case.pattern-matching-error)))))) (def: #export (case generate [valueS pathP]) (-> Phase [Synthesis Path] (Operation Computation)) - (do ////.monad + (do ///////phase.monad [stack-init (generate valueS) path! (pattern-matching generate pathP) #let [closure (<| (_.closure (list)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension.lux deleted file mode 100644 index 71739bfc9..000000000 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension.lux +++ /dev/null @@ -1,15 +0,0 @@ -(.module: - [lux #* - [data - [collection - ["." dictionary]]]] - [// - [runtime (#+ Bundle)]] - [/ - ["." common] - ["." host]]) - -(def: #export bundle - Bundle - (dictionary.merge common.bundle - host.bundle)) 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 ec48162c5..75399ef04 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 @@ -14,35 +14,35 @@ [runtime (#+ Operation Phase)] ["#." reference] ["#." case] - ["#/" // + ["/#" // #_ ["#." reference] - ["#/" // ("#@." monad) - ["." // #_ - [reference (#+ Register Variable)] + ["//#" /// #_ + [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)] + [synthesis (#+ Synthesis)] + ["#." generation] + ["//#" /// #_ [arity (#+ Arity)] - [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)] - [synthesis (#+ Synthesis)]]]]]) + [reference (#+ Register Variable)] + ["#." phase ("#@." monad)]]]]]) (def: #export (apply generate [functionS argsS+]) (-> Phase (Application Synthesis) (Operation Computation)) - (do ////.monad + (do ///////phase.monad [functionO (generate functionS) argsO+ (monad.map @ generate argsS+)] (wrap (_.apply/* functionO argsO+)))) -(def: #export capture - (///reference.foreign _.var)) - (def: (with-closure inits function-definition) (-> (List Expression) Computation (Operation Computation)) - (////@wrap + (///////phase@wrap (case inits #.Nil function-definition _ - (let [closure (_.closure (|> (list.enumerate inits) - (list@map (|>> product.left ..capture))) + (let [capture (///reference.foreign _.var) + closure (_.closure (|> (list.enumerate inits) + (list@map (|>> product.left capture))) (_.return function-definition))] (_.apply/* closure inits))))) @@ -55,14 +55,15 @@ (def: #export (function generate [environment arity bodyS]) (-> Phase (Abstraction Synthesis) (Operation Computation)) - (do ////.monad - [[function-name bodyO] (///.with-context + (do ///////phase.monad + [[function-name bodyO] (/////generation.with-context (do @ - [function-name ///.context] - (///.with-anchor (_.var function-name) + [function-name /////generation.context] + (/////generation.with-anchor (_.var function-name) (generate bodyS)))) + #let [capture (:: //reference.system variable)] closureO+ (: (Operation (List Expression)) - (monad.map @ (:: //reference.system variable) environment)) + (monad.map @ capture environment)) #let [arityO (|> arity .int _.i32) @num-args (_.var "num_args") @self (_.var function-name) 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 101c49b95..3479de19b 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 @@ -14,18 +14,19 @@ ["." // #_ [runtime (#+ Operation Phase)] ["#." case] - ["#/" // - ["#/" // - [// - [synthesis (#+ Scope Synthesis)]]]]]) + ["///#" //// #_ + [synthesis (#+ Scope Synthesis)] + ["#." generation] + ["//#" /// #_ + ["#." phase]]]]) (def: @scope (_.var "scope")) (def: #export (scope generate [start initsS+ bodyS]) (-> Phase (Scope Synthesis) (Operation Computation)) - (do ////.monad + (do ///////phase.monad [initsO+ (monad.map @ generate initsS+) - bodyO (///.with-anchor @scope + bodyO (/////generation.with-anchor @scope (generate bodyS)) #let [closure (_.function @scope (|> initsS+ @@ -36,7 +37,7 @@ (def: #export (recur generate argsS+) (-> Phase (List Synthesis) (Operation Computation)) - (do ////.monad - [@scope ///.anchor + (do ///////phase.monad + [@scope /////generation.anchor argsO+ (monad.map @ generate argsS+)] (wrap (_.apply/* @scope argsO+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux index 4ac7483fa..183b35650 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux @@ -2,10 +2,10 @@ [lux #* [target ["_" js (#+ Expression)]]] - [// - [// - ["." reference]]]) + [/// + ["/" reference]]) (def: #export system - (reference.system (: (-> Text Expression) _.var) - (: (-> Text Expression) _.var))) + (let [constant (: (-> Text Expression) _.var) + variable constant] + (/.system constant variable))) 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 949e663c7..1c1b7379d 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 @@ -18,21 +18,22 @@ [syntax (#+ syntax:)]] [target ["_" js (#+ Expression Var Computation Statement)]]] - ["." /// - ["//." // - [// - ["/////." name] - ["." synthesis]]]] + ["." ///// #_ + ["#." synthesis] + ["#." generation] + ["//#" /// #_ + ["#." phase] + ["#." name]]] ) (template [<name> <base>] [(type: #export <name> (<base> Var Expression Statement))] - [Operation ///.Operation] - [Phase ///.Phase] - [Handler ///.Handler] - [Bundle ///.Bundle] + [Operation /////generation.Operation] + [Phase /////generation.Phase] + [Handler /////generation.Handler] + [Bundle /////generation.Bundle] ) (type: #export (Generator i) @@ -53,7 +54,7 @@ (def: #export variant-flag-field "_lux_flag") (def: #export variant-value-field "_lux_value") -(def: #export unit Computation (_.string synthesis.unit)) +(def: #export unit Computation (_.string /////synthesis.unit)) (def: #export (flag value) (-> Bit Computation) @@ -85,12 +86,12 @@ (def: variable (-> Text Var) - (|>> /////name.normalize + (|>> ///////name.normalize _.var)) (def: runtime-name (-> Text Var) - (|>> /////name.normalize + (|>> ///////name.normalize (format ..prefix "$") _.var)) @@ -103,7 +104,7 @@ (wrap (list (` (let [(~+ (|> vars (list;map (function (_ var) (list (code.local-identifier var) - (` (_.var (~ (code.text (/////name.normalize var)))))))) + (` (_.var (~ (code.text (///////name.normalize var)))))))) list.concat))] (~ body)))))) @@ -734,10 +735,10 @@ (def: #export generate (Operation Any) - (///.with-buffer - (do ////.monad - [_ (///.save! true ["" ..prefix] - ($_ _.then - _.use-strict - ..runtime))] - (///.save-buffer! ..artifact)))) + (/////generation.with-buffer + (do ///////phase.monad + [_ (/////generation.save! true ["" ..prefix] + ($_ _.then + _.use-strict + ..runtime))] + (/////generation.save-buffer! ..artifact)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux index c721c991c..a1f05d050 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux @@ -7,10 +7,11 @@ ["." // #_ ["#." runtime (#+ Operation Phase)] ["#." primitive] - ["#//" /// - ["#/" // #_ - [analysis (#+ Variant Tuple)] - ["#." synthesis (#+ Synthesis)]]]]) + ["///#" //// #_ + [analysis (#+ Variant Tuple)] + ["#." synthesis (#+ Synthesis)] + ["//#" /// + ["#." phase ("#@." monad)]]]]) (def: unit Expression (//primitive.text /////synthesis.unit)) @@ -18,21 +19,21 @@ (-> Phase (Tuple Synthesis) (Operation Expression)) (case elemsS+ #.Nil - (:: ////.monad wrap ..unit) + (///////phase@wrap ..unit) (#.Cons singletonS #.Nil) (generate singletonS) _ - (do ////.monad + (do ///////phase.monad [elemsT+ (monad.map @ generate elemsS+)] (wrap (_.array elemsT+))))) (def: #export (variant generate [lefts right? valueS]) (-> Phase (Variant Synthesis) (Operation Expression)) - (:: ////.monad map - (//runtime.variant (_.i32 (.int (if right? - (inc lefts) - lefts))) - (//runtime.flag right?)) - (generate valueS))) + (let [tag (if right? + (inc lefts) + lefts)] + (///////phase@map (//runtime.variant (_.i32 (.int tag)) + (//runtime.flag right?)) + (generate valueS)))) 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 8a80953e9..e75c8e41e 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 @@ -6,11 +6,12 @@ [text ["%" format (#+ format)]]] [type (#+ :share)]] - ["." // - ["#/" // ("#@." monad) - ["#/" // #_ - [synthesis (#+ Synthesis)] - ["#." reference (#+ Register Variable Reference)]]]]) + ["." //// #_ + [synthesis (#+ Synthesis)] + ["#." generation] + ["//#" /// #_ + ["#." reference (#+ Register Variable Reference)] + ["#." phase ("#@." monad)]]]) (signature: #export (System expression) (: (-> Register expression) @@ -18,13 +19,13 @@ (: (-> Register expression) foreign) (: (All [anchor directive] - (-> Variable (//.Operation anchor expression directive))) + (-> Variable (////generation.Operation anchor expression directive))) variable) (: (All [anchor directive] - (-> Name (//.Operation anchor expression directive))) + (-> Name (////generation.Operation anchor expression directive))) constant) (: (All [anchor directive] - (-> Reference (//.Operation anchor expression directive))) + (-> Reference (////generation.Operation anchor expression directive))) reference)) (def: (variable-maker prefix variable) @@ -33,17 +34,16 @@ (-> Register expression))) (|>> %.nat (format prefix) variable)) -(def: #export foreign - (All [expression] - (-> (-> Text expression) - (-> Register expression))) - (variable-maker "f")) +(template [<sigil> <name>] + [(def: #export <name> + (All [expression] + (-> (-> Text expression) + (-> Register expression))) + (variable-maker <sigil>))] -(def: #export local - (All [expression] - (-> (-> Text expression) - (-> Register expression))) - (variable-maker "l")) + ["f" foreign] + ["l" local] + ) (def: #export (system constant variable) (All [expression] @@ -55,27 +55,27 @@ {(-> Text expression) variable} {(All [anchor directive] - (-> Variable (//.Operation anchor expression directive))) - (|>> (case> (#////reference.Local register) + (-> Variable (////generation.Operation anchor expression directive))) + (|>> (case> (#//////reference.Local register) (local register) - (#////reference.Foreign register) + (#//////reference.Foreign register) (foreign register)) - ///@wrap)}) + //////phase@wrap)}) constant (:share [expression] {(-> Text expression) constant} {(All [anchor directive] - (-> Name (//.Operation anchor expression directive))) - (|>> //.remember (///@map constant))})] + (-> Name (////generation.Operation anchor expression directive))) + (|>> ////generation.remember (//////phase@map constant))})] (structure (def: local local) (def: foreign foreign) (def: variable variable) (def: constant constant) (def: reference - (|>> (case> (#////reference.Constant value) + (|>> (case> (#//////reference.Constant value) (constant value) - (#////reference.Variable value) + (#//////reference.Variable value) (variable value))))))) diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index 4d37ed458..cbc89fce9 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -2,10 +2,12 @@ [lux #* ["_" test (#+ Test)]] ["." / #_ + ["#." codec] ["#." interval]]) (def: #export test Test ($_ _.and + /codec.test /interval.test )) diff --git a/stdlib/source/test/lux/abstract/codec.lux b/stdlib/source/test/lux/abstract/codec.lux index b6bbdd91e..84a3997b3 100644 --- a/stdlib/source/test/lux/abstract/codec.lux +++ b/stdlib/source/test/lux/abstract/codec.lux @@ -5,7 +5,12 @@ [control ["." try]] [data - ["%" text/format (#+ format)]] + ["." bit ("#@." equivalence)] + ["%" text/format (#+ format)] + [format + ["." json (#+ JSON)]] + [collection + [dictionary]]] [math ["r" random (#+ Random)]]] {1 @@ -13,6 +18,35 @@ [// [equivalence (#+ Equivalence)]]]}) +(def: json + (Codec JSON Bit) + (let [field "value"] + (structure + (def: encode + (|>> #json.Boolean + [field] + list + (json.object))) + (def: decode + (json.get-boolean field))))) + +(def: codec + (Codec Text Bit) + (/.compose json.codec ..json)) + +(def: #export test + Test + (do r.monad + [expected r.bit] + (<| (_.context (%.name (name-of /.Codec))) + (_.test "Composition." + (case (|> expected (:: ..codec encode) (:: ..codec decode)) + (#try.Success actual) + (bit@= expected actual) + + (#try.Failure error) + false))))) + (def: #export (spec (^open "/@.") (^open "/@.") generator) (All [m a] (-> (Equivalence a) (Codec m a) (Random a) Test)) (do r.monad diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 23c33c620..6160294c4 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -14,12 +14,14 @@ ["%" format (#+ format)]]] [tool [compiler - ["." analysis] - ["." synthesis] - ["." directive] - [phase - [analysis - ["." type]]]]] + [language + [lux + ["." analysis] + ["." synthesis] + ["." directive] + [phase + [analysis + ["." type]]]]]]] ["_" test (#+ Test)]] {1 ["." / (#+ analysis: synthesis: generation: directive:)]}) |