diff options
Diffstat (limited to 'stdlib')
47 files changed, 839 insertions, 637 deletions
diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index fba2fe53e..ab6f6940f 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -12,11 +12,8 @@ [macro ["." code] [syntax (#+ syntax:) - ["cs" common - ["csr" reader] - ["csw" writer] - ["|.|" export] - ["|.|" annotations]]]] + ["|.|" export] + ["|.|" annotations]]] [math [number ["n" nat] diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index ebdc3d514..21c2b2d58 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -19,11 +19,9 @@ [macro ["." code] [syntax (#+ syntax:) - ["cs" common - ["csr" reader] - ["csw" writer] - ["|.|" export] - ["|.|" annotations]]]] + ["|.|" input] + ["|.|" export] + ["|.|" annotations]]] [math [number ["n" nat]]] @@ -342,7 +340,7 @@ (type: Signature {#vars (List Text) #name Text - #inputs (List cs.Typed_Input) + #inputs (List |input|.Input) #state Text #self Text #output Code}) @@ -352,7 +350,7 @@ (<c>.form ($_ <>.and (<>.default (list) (<c>.tuple (<>.some <c>.local_identifier))) <c>.local_identifier - (<>.some csr.typed_input) + (<>.some |input|.parser) <c>.local_identifier <c>.local_identifier <c>.any))) @@ -379,9 +377,9 @@ #let [g!type (code.local_identifier (get@ #abstract.name actor_scope)) g!message (code.local_identifier (get@ #name signature)) g!actor_vars (get@ #abstract.type_vars actor_scope) - g!all_vars (|> (get@ #vars signature) (list\map code.local_identifier) (list\compose g!actor_vars)) - g!inputsC (|> (get@ #inputs signature) (list\map product.left)) - g!inputsT (|> (get@ #inputs signature) (list\map product.right)) + g!all_vars (|> signature (get@ #vars) (list\map code.local_identifier) (list\compose g!actor_vars)) + g!inputsC (|> signature (get@ #inputs) (list\map product.left)) + g!inputsT (|> signature (get@ #inputs) (list\map product.right)) g!state (|> signature (get@ #state) code.local_identifier) g!self (|> signature (get@ #self) code.local_identifier)]] (wrap (list (` (def: (~+ (|export|.write export)) ((~ g!message) (~+ g!inputsC)) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 63f4a0853..dcbb6ecfc 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -15,12 +15,10 @@ [macro ["." code] [syntax (#+ syntax:) - ["sc" common - ["scr" reader] - ["scw" writer] - ["|.|" export] - ["." type #_ - ["|#_.|" variable]]]]] + ["|.|" export] + ["|.|" input] + ["." type #_ + ["|#_.|" variable]]]] [math [number ["n" nat ("#\." decimal)]]]] @@ -90,7 +88,7 @@ (syntax: #export (exception: {export |export|.parser} {t_vars (p.default (list) (s.tuple (p.some |type_variable|.parser)))} {[name inputs] (p.either (p.and s.local_identifier (wrap (list))) - (s.form (p.and s.local_identifier (p.some scr.typed_input))))} + (s.form (p.and s.local_identifier (p.some |input|.parser))))} {body (p.maybe s.any)}) {#.doc (doc "Define a new exception type." "It mostly just serves as a way to tag error messages for later catching." @@ -109,10 +107,10 @@ (wrap (list (` (def: (~+ (|export|.write export)) (~ g!self) (All [(~+ (list\map |type_variable|.format t_vars))] - (..Exception [(~+ (list\map (get@ #sc.input_type) inputs))])) + (..Exception [(~+ (list\map (get@ #|input|.type) inputs))])) (let [(~ g!descriptor) (~ (code.text descriptor))] {#..label (~ g!descriptor) - #..constructor (function ((~ g!self) [(~+ (list\map (get@ #sc.input_binding) inputs))]) + #..constructor (function ((~ g!self) [(~+ (list\map (get@ #|input|.binding) inputs))]) ((~! text\compose) (~ g!descriptor) (~ (maybe.default (' "") body))))}))))) ))) diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index 8f2430bff..b94bd79cf 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -19,12 +19,9 @@ [macro ["." code] [syntax (#+ syntax:) - [common - ["." reader] - ["." writer] - ["|.|" export] - ["|.|" declaration] - ["|.|" annotations]]]]]) + ["|.|" export] + ["|.|" declaration] + ["|.|" annotations]]]]) (abstract: #export (Capability brand input output) (-> input output) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index a50493fc6..8f571f61c 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -18,10 +18,7 @@ [macro ["." code] [syntax (#+ syntax:) - [common - ["csr" reader] - ["csw" writer] - ["|.|" export]]]] + ["|.|" export]]] [math [number ["n" nat]]]]) diff --git a/stdlib/source/lux/macro/syntax/common/annotations.lux b/stdlib/source/lux/macro/syntax/annotations.lux index e1ee52274..e1ee52274 100644 --- a/stdlib/source/lux/macro/syntax/common/annotations.lux +++ b/stdlib/source/lux/macro/syntax/annotations.lux diff --git a/stdlib/source/lux/macro/syntax/common/check.lux b/stdlib/source/lux/macro/syntax/check.lux index 081e394b0..081e394b0 100644 --- a/stdlib/source/lux/macro/syntax/common/check.lux +++ b/stdlib/source/lux/macro/syntax/check.lux diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux deleted file mode 100644 index 8cfbdeddd..000000000 --- a/stdlib/source/lux/macro/syntax/common.lux +++ /dev/null @@ -1,7 +0,0 @@ -(.module: {#.doc (.doc "Commons syntax readers and writers." - "The goal is to be able to reuse common syntax in macro definitions across libraries.")} - [lux #*]) - -(type: #export Typed_Input - {#input_binding Code - #input_type Code}) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux deleted file mode 100644 index cd7ca1dce..000000000 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ /dev/null @@ -1,20 +0,0 @@ -(.module: {#.doc "Commons syntax readers."} - [lux #* - [abstract - monad] - [control - ["p" parser ("#\." monad) - ["s" code (#+ Parser)]]] - [data - ["." name ("#\." equivalence)] - ["." product] - ["." maybe] - [collection - ["." list]]] - ["." meta]] - ["." //]) - -(def: #export typed_input - {#.doc "Reader for the common typed-argument syntax used by many macros."} - (Parser //.Typed_Input) - (s.record (p.and s.any s.any))) diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux deleted file mode 100644 index 18b6556b8..000000000 --- a/stdlib/source/lux/macro/syntax/common/writer.lux +++ /dev/null @@ -1,17 +0,0 @@ -(.module: - {#.doc "Commons syntax writers."} - [lux #* - [control - ["." function]] - [data - [collection - ["." list ("#\." functor)]] - ["." product]] - [macro - ["." code]]] - ["." //]) - -(def: #export (typed_input value) - (-> //.Typed_Input Code) - (code.record (list [(get@ #//.input_binding value) - (get@ #//.input_type value)]))) diff --git a/stdlib/source/lux/macro/syntax/common/declaration.lux b/stdlib/source/lux/macro/syntax/declaration.lux index 9a72a8a0c..9a72a8a0c 100644 --- a/stdlib/source/lux/macro/syntax/common/declaration.lux +++ b/stdlib/source/lux/macro/syntax/declaration.lux diff --git a/stdlib/source/lux/macro/syntax/common/definition.lux b/stdlib/source/lux/macro/syntax/definition.lux index cdb382dc1..cdb382dc1 100644 --- a/stdlib/source/lux/macro/syntax/common/definition.lux +++ b/stdlib/source/lux/macro/syntax/definition.lux diff --git a/stdlib/source/lux/macro/syntax/common/export.lux b/stdlib/source/lux/macro/syntax/export.lux index e89f908e4..e89f908e4 100644 --- a/stdlib/source/lux/macro/syntax/common/export.lux +++ b/stdlib/source/lux/macro/syntax/export.lux diff --git a/stdlib/source/lux/macro/syntax/input.lux b/stdlib/source/lux/macro/syntax/input.lux new file mode 100644 index 000000000..9b9fcb576 --- /dev/null +++ b/stdlib/source/lux/macro/syntax/input.lux @@ -0,0 +1,37 @@ +(.module: + [lux #* + [abstract + [equivalence (#+ Equivalence)]] + [control + ["<>" parser + ["<.>" code (#+ Parser)]]] + [data + ["." product]] + [macro + ["." code]]]) + +(type: #export Input + {#binding Code + #type Code}) + +(def: #export equivalence + (Equivalence Input) + ($_ product.equivalence + code.equivalence + code.equivalence + )) + +(def: #export (format value) + (-> Input Code) + (code.record + (list [(get@ #binding value) + (get@ #type value)]))) + +(def: #export parser + {#.doc "Parser for the common typed-argument syntax used by many macros."} + (Parser Input) + (<code>.record + ($_ <>.and + <code>.any + <code>.any + ))) diff --git a/stdlib/source/lux/macro/syntax/common/type/variable.lux b/stdlib/source/lux/macro/syntax/type/variable.lux index 22f37a35c..22f37a35c 100644 --- a/stdlib/source/lux/macro/syntax/common/type/variable.lux +++ b/stdlib/source/lux/macro/syntax/type/variable.lux diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index 0e50c5d50..a98e1c2d0 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -4,13 +4,17 @@ [abstract ["." monad (#+ do)]] [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] ["<>" parser ("#\." functor) ["<.>" code (#+ Parser)]]] [data ["." bit ("#\." codec)] ["." text] [collection - ["." list ("#\." monad)]]] + ["." list ("#\." monad fold)] + ["." dictionary (#+ Dictionary) + ["." plist]]]] [math [number ["." nat ("#\." decimal)] @@ -91,3 +95,124 @@ [identifier code.local_identifier code.identifier] [tag code.local_tag code.tag] ) + +(type: Environment + (Dictionary Text Code)) + +(def: (apply env template) + (-> Environment Code Code) + (case template + [_ (#.Identifier "" name)] + (case (dictionary.get name env) + (#.Some substitute) + substitute + + #.None + template) + + (^template [<tag>] + [[meta (<tag> elems)] + [meta (<tag> (list\map (apply env) elems))]]) + ([#.Tuple] + [#.Form]) + + [meta (#.Record members)] + [meta (#.Record (list\map (: (-> [Code Code] [Code Code]) + (function (_ [key value]) + [(apply env key) + (apply env value)])) + members))] + + _ + template)) + +(type: Local + {#name Text + #parameters (List Text) + #template Code}) + +(exception: #export (irregular_arguments {expected Nat} {actual Nat}) + (exception.report + ["Expected" (\ nat.decimal encode expected)] + ["Actual" (\ nat.decimal encode actual)])) + +(def: (macro (^slots [#parameters #template])) + (-> Local Macro') + (function (_ inputs compiler) + (let [parameters_count (list.size parameters) + inputs_count (list.size inputs)] + (if (nat.= parameters_count inputs_count) + (let [environment (: Environment + (|> (list.zip/2 parameters inputs) + (dictionary.from_list text.hash)))] + (#.Right [compiler (list (..apply environment template))])) + (exception.throw ..irregular_arguments [parameters_count inputs_count]))))) + +(def: local + (Parser Local) + (do <>.monad + [[name parameters] (<code>.form (<>.and <code>.local_identifier + (<>.many <code>.local_identifier))) + template <code>.any] + (wrap {#name name + #parameters parameters + #template template}))) + +(exception: #export (cannot_shadow_definition {module Text} {definition Text}) + (exception.report + ["Module" (text.encode module)] + ["Definition" (text.encode definition)])) + +(def: (push module_name local module) + (-> Text Local Module (Try Module)) + (let [definition (get@ #name local)] + (case (plist.get definition (get@ #.definitions module)) + #.None + (#try.Success (update@ #.definitions + (plist.put definition + (#.Definition [false .Macro (' []) (..macro local)])) + module)) + + (#.Some _) + (exception.throw ..cannot_shadow_definition [module_name definition])))) + +(syntax: (pop {locals (<>.some <code>.text)}) + (do meta.monad + [here_name meta.current_module_name + here meta.current_module] + (function (_ compiler) + (#.Right [(let [definitions (list\fold plist.remove + (get@ #.definitions here) + locals)] + (update@ #.modules + (plist.put here_name (set@ #.definitions definitions here)) + compiler)) + (case (get@ #.expected compiler) + #.None + (list) + + (#.Some _) + (list (' [])))])))) + +(syntax: #export (with {locals (<code>.tuple (<>.some ..local))} + body) + (do meta.monad + [here_name meta.current_module_name + here meta.current_module] + (meta.with_gensyms [g!body] + (function (_ compiler) + (do try.monad + [here (monad.fold try.monad (..push here_name) here locals) + #let [compiler (update@ #.modules (plist.put here_name here) compiler) + pop! (` ((~! ..pop) (~+ (list\map (|>> (get@ #name) code.text) + locals))))]] + (wrap [compiler + (case (get@ #.expected compiler) + #.None + (list body + pop!) + + (#.Some _) + (list (` (let [(~ g!body) (~ body)] + (exec (~ pop!) + (~ g!body))))))])))))) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 5af6de041..4b6670de7 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -29,7 +29,7 @@ ["r" ratio] ["c" complex] ["." i64]]] - [time + ["." time (#+ Time) ["." instant (#+ Instant)] ["." date (#+ Date)] ["." duration (#+ Duration)] @@ -305,6 +305,10 @@ (Random Date) (\ ..monad map instant.date ..instant)) +(def: #export time + (Random Time) + (\ ..monad map instant.time ..instant)) + (def: #export duration (Random Duration) (\ ..monad map duration.from_millis ..int)) diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 41e66d4a8..48e4e7d41 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -34,8 +34,6 @@ (dictionary.new n.hash) //month.year)) -(exception: #export there_is_no_year_0) - (def: minimum_day 1) (def: (month_days year month) @@ -275,7 +273,7 @@ utc_year))) ## http://howardhinnant.github.io/date_algorithms.html -(def: #export (days date) +(def: #export (to_days date) (-> Date Int) (let [utc_month (|> date ..month //month.number) civil_year (..civil_year utc_month (..year date)) @@ -337,7 +335,7 @@ (def: &order ..order) (def: succ - (|>> ..days inc ..from_days)) + (|>> ..to_days inc ..from_days)) (def: pred - (|>> ..days dec ..from_days))) + (|>> ..to_days dec ..from_days))) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 33cd2e5a4..48bc5414a 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -129,7 +129,7 @@ (def: parser (Parser Instant) (do {! <>.monad} - [days (\ ! map date.days date.parser) + [days (\ ! map date.to_days date.parser) _ (<t>.this ..date_suffix) time (\ ! map //.to_millis //.parser) _ (<t>.this ..time_suffix)] @@ -190,5 +190,5 @@ (def: #export (from_date_time date time) (-> Date Time Instant) (..from_millis - (i.+ (i.* (date.days date) (duration.to_millis duration.day)) + (i.+ (i.* (date.to_days date) (duration.to_millis duration.day)) (.int (//.to_millis time))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux index 708b93ddd..764479799 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux @@ -33,9 +33,9 @@ [<c>.any (function (_ extension phase archive lengthC) (do phase.monad - [lengthA (type.with-type Nat + [lengthA (type.with_type Nat (phase archive lengthC)) - [var-id varT] (type.with-env check.var) + [var_id varT] (type.with_env check.var) _ (type.infer (type (Array varT)))] (wrap (#analysis.Extension extension (list lengthA)))))])) @@ -45,8 +45,8 @@ [<c>.any (function (_ extension phase archive arrayC) (do phase.monad - [[var-id varT] (type.with-env check.var) - arrayA (type.with-type (type (Array varT)) + [[var_id varT] (type.with_env check.var) + arrayA (type.with_type (type (Array varT)) (phase archive arrayC)) _ (type.infer Nat)] (wrap (#analysis.Extension extension (list arrayA)))))])) @@ -57,10 +57,10 @@ [(<>.and <c>.any <c>.any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad - [indexA (type.with-type Nat + [indexA (type.with_type Nat (phase archive indexC)) - [var-id varT] (type.with-env check.var) - arrayA (type.with-type (type (Array varT)) + [var_id varT] (type.with_env check.var) + arrayA (type.with_type (type (Array varT)) (phase archive arrayC)) _ (type.infer varT)] (wrap (#analysis.Extension extension (list indexA arrayA)))))])) @@ -71,12 +71,12 @@ [($_ <>.and <c>.any <c>.any <c>.any) (function (_ extension phase archive [indexC valueC arrayC]) (do phase.monad - [indexA (type.with-type Nat + [indexA (type.with_type Nat (phase archive indexC)) - [var-id varT] (type.with-env check.var) - valueA (type.with-type varT + [var_id varT] (type.with_env check.var) + valueA (type.with_type varT (phase archive valueC)) - arrayA (type.with-type (type (Array varT)) + arrayA (type.with_type (type (Array varT)) (phase archive arrayC)) _ (type.infer (type (Array varT)))] (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))])) @@ -87,10 +87,10 @@ [($_ <>.and <c>.any <c>.any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad - [indexA (type.with-type Nat + [indexA (type.with_type Nat (phase archive indexC)) - [var-id varT] (type.with-env check.var) - arrayA (type.with-type (type (Array varT)) + [var_id varT] (type.with_env check.var) + arrayA (type.with_type (type (Array varT)) (phase archive arrayC)) _ (type.infer (type (Array varT)))] (wrap (#analysis.Extension extension (list indexA arrayA)))))])) @@ -112,9 +112,9 @@ [($_ <>.and <c>.any (<c>.tuple (<>.some <c>.any))) (function (_ extension phase archive [constructorC inputsC]) (do {! phase.monad} - [constructorA (type.with-type Any + [constructorA (type.with_type Any (phase archive constructorC)) - inputsA (monad.map ! (|>> (phase archive) (type.with-type Any)) inputsC) + inputsA (monad.map ! (|>> (phase archive) (type.with_type Any)) inputsC) _ (type.infer .Any)] (wrap (#analysis.Extension extension (list& constructorA inputsA)))))])) @@ -124,7 +124,7 @@ [($_ <>.and <c>.text <c>.any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad - [objectA (type.with-type Any + [objectA (type.with_type Any (phase archive objectC)) _ (type.infer .Any)] (wrap (#analysis.Extension extension (list (analysis.text fieldC) @@ -136,9 +136,9 @@ [($_ <>.and <c>.text <c>.any (<c>.tuple (<>.some <c>.any))) (function (_ extension phase archive [methodC objectC inputsC]) (do {! phase.monad} - [objectA (type.with-type Any + [objectA (type.with_type Any (phase archive objectC)) - inputsA (monad.map ! (|>> (phase archive) (type.with-type Any)) inputsC) + inputsA (monad.map ! (|>> (phase archive) (type.with_type Any)) inputsC) _ (type.infer .Any)] (wrap (#analysis.Extension extension (list& (analysis.text methodC) objectA @@ -172,19 +172,19 @@ [($_ <>.and <c>.any (<>.some <c>.any)) (function (_ extension phase archive [abstractionC inputsC]) (do {! phase.monad} - [abstractionA (type.with-type Any + [abstractionA (type.with_type Any (phase archive abstractionC)) - inputsA (monad.map ! (|>> (phase archive) (type.with-type Any)) inputsC) + inputsA (monad.map ! (|>> (phase archive) (type.with_type Any)) inputsC) _ (type.infer Any)] (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))])) -(def: js::type-of +(def: js::type_of Handler (custom [<c>.any (function (_ extension phase archive objectC) (do phase.monad - [objectA (type.with-type Any + [objectA (type.with_type Any (phase archive objectC)) _ (type.infer .Text)] (wrap (#analysis.Extension extension (list objectA)))))])) @@ -196,7 +196,7 @@ (function (_ extension phase archive [arity abstractionC]) (do phase.monad [#let [inputT (tuple (list.repeat arity Any))] - abstractionA (type.with-type (-> inputT Any) + abstractionA (type.with_type (-> inputT Any) (phase archive abstractionC)) _ (type.infer (for {@.js host.Function} Any))] @@ -209,7 +209,7 @@ (|> bundle.empty (bundle.install "constant" js::constant) (bundle.install "apply" js::apply) - (bundle.install "type-of" js::type-of) + (bundle.install "type-of" js::type_of) (bundle.install "function" js::function) (dictionary.merge bundle::array) (dictionary.merge bundle::object) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index 1485d7230..03b2ca14b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -8,11 +8,12 @@ ["<s>" synthesis (#+ Parser)]]] [data ["." product] - [number - ["f" frac]] [collection ["." list ("#\." functor)] ["." dictionary]]] + [math + [number + ["f" frac]]] ["@" target ["_" js (#+ Literal Expression Statement)]]] ["." //// #_ @@ -35,24 +36,24 @@ (-> [(Parser s) (-> Text (Generator s))] Handler)) - (function (_ extension-name phase archive input) + (function (_ extension_name phase archive input) (case (<s>.run parser input) (#try.Success input') - (handler extension-name phase archive input') + (handler extension_name phase archive input') (#try.Failure error) - (/////.throw extension.invalid-syntax [extension-name %synthesis input])))) + (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) ## [Procedures] ## [[Bits]] (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]] @@ -66,7 +67,7 @@ (def: i64//char (Unary Expression) - (|>> //runtime.i64//to-number + (|>> //runtime.i64//to_number (list) (_.apply/* (_.var "String.fromCharCode")))) @@ -92,37 +93,37 @@ (def: (io//exit codeG) (Unary Expression) - (let [exit-node-js! (let [@@process (_.var "process")] - (|> (_.not (_.= _.undefined (_.type-of @@process))) + (let [exit_node_js! (let [@@process (_.var "process")] + (|> (_.not (_.= _.undefined (_.type_of @@process))) (_.and (_.the "exit" @@process)) - (_.and (_.do "exit" (list (//runtime.i64//to-number codeG)) @@process)))) - close-browser-window! (let [@@window (_.var "window")] - (|> (_.not (_.= _.undefined (_.type-of @@window))) + (_.and (_.do "exit" (list (//runtime.i64//to_number codeG)) @@process)))) + close_browser_window! (let [@@window (_.var "window")] + (|> (_.not (_.= _.undefined (_.type_of @@window))) (_.and (_.the "close" @@window)) (_.and (_.do "close" (list) @@window)))) - reload-page! (let [@@location (_.var "location")] - (|> (_.not (_.= _.undefined (_.type-of @@location))) + reload_page! (let [@@location (_.var "location")] + (|> (_.not (_.= _.undefined (_.type_of @@location))) (_.and (_.the "reload" @@location)) (_.and (_.do "reload" (list) @@location))))] - (|> exit-node-js! - (_.or close-browser-window!) - (_.or reload-page!)))) + (|> exit_node_js! + (_.or close_browser_window!) + (_.or reload_page!)))) -(def: (io//current-time _) +(def: (io//current_time _) (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! +(def: lux::syntax_char_case! (..custom [($_ <>.and <s>.any <s>.any (<>.some (<s>.tuple ($_ <>.and (<s>.tuple (<>.many <s>.i64)) <s>.any)))) - (function (_ extension-name phase archive [input else conditionals]) + (function (_ extension_name phase archive [input else conditionals]) (do {! /////.monad} [inputG (phase archive input) elseG (phase archive else) @@ -135,29 +136,29 @@ (_.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)))))])) ## [Bundles] -(def: lux-procs +(def: lux_procs Bundle (|> /.empty - (/.install "syntax char case!" lux::syntax-char-case!) + (/.install "syntax char case!" lux::syntax_char_case!) (/.install "is" (binary (product.uncurry _.=))) (/.install "try" (unary //runtime.lux//try)))) -(def: i64-procs +(def: i64_procs Bundle (<| (/.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 "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//+))) @@ -165,11 +166,11 @@ (/.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 "f64" (unary //runtime.i64//to_number)) (/.install "char" (unary i64//char)) ))) -(def: f64-procs +(def: f64_procs Bundle (<| (/.prefix "f64") (|> /.empty @@ -180,11 +181,11 @@ (/.install "%" (binary (product.uncurry _.%))) (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) - (/.install "i64" (unary //runtime.i64//from-number)) + (/.install "i64" (unary //runtime.i64//from_number)) (/.install "encode" (unary (_.do "toString" (list)))) (/.install "decode" (unary f64//decode))))) -(def: text-procs +(def: text_procs Bundle (<| (/.prefix "text") (|> /.empty @@ -192,26 +193,26 @@ (/.install "<" (binary (product.uncurry _.<))) (/.install "concat" (binary text//concat)) (/.install "index" (trinary text//index)) - (/.install "size" (unary (|>> (_.the "length") //runtime.i64//from-number))) + (/.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 +(def: io_procs Bundle (<| (/.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))))) + (/.install "current-time" (nullary io//current_time))))) (def: #export bundle Bundle (<| (/.prefix "lux") - (|> lux-procs - (dictionary.merge i64-procs) - (dictionary.merge f64-procs) - (dictionary.merge text-procs) - (dictionary.merge io-procs) + (|> lux_procs + (dictionary.merge i64_procs) + (dictionary.merge f64_procs) + (dictionary.merge text_procs) + (dictionary.merge io_procs) ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux index 0aeea4cd2..c81705f24 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux @@ -23,7 +23,7 @@ nullary unary binary trinary)] ["//" js #_ ["#." runtime (#+ Operation Phase Handler Bundle - with-vars)]]] + with_vars)]]] ["/#" // #_ ["." generation] ["//#" /// #_ @@ -31,15 +31,15 @@ (def: array::new (Unary Expression) - (|>> (_.the //runtime.i64-low-field) list (_.new (_.var "Array")))) + (|>> (_.the //runtime.i64_low_field) 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) - (_.at (_.the //runtime.i64-low-field indexG) + (_.at (_.the //runtime.i64_low_field indexG) arrayG)) (def: (array::write [indexG valueG arrayG]) @@ -153,7 +153,7 @@ (|> /.empty (/.install "constant" js::constant) (/.install "apply" js::apply) - (/.install "type-of" (unary _.type-of)) + (/.install "type-of" (unary _.type_of)) (/.install "function" js::function) (dictionary.merge ..array) (dictionary.merge ..object) 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 13038972b..3a828bbb9 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 @@ -7,10 +7,11 @@ [data ["." maybe] ["." text] - [number - ["n" nat]] [collection ["." list ("#\." functor fold)]]] + [math + [number + ["n" nat]]] [target ["_" js (#+ Expression Computation Var Statement)]]] ["." // #_ @@ -89,40 +90,40 @@ (def: @cursor (_.var "lux_pm_cursor")) (def: @temp (_.var "lux_pm_temp")) -(def: (push-cursor! value) +(def: (push_cursor! value) (-> Expression Statement) (_.statement (|> @cursor (_.do "push" (list value))))) -(def: peek-and-pop-cursor +(def: peek_and_pop_cursor Expression (|> @cursor (_.do "pop" (list)))) -(def: pop-cursor! +(def: pop_cursor! Statement - (_.statement ..peek-and-pop-cursor)) + (_.statement ..peek_and_pop_cursor)) (def: length (|>> (_.the "length"))) -(def: last-index +(def: last_index (|>> ..length (_.- (_.i32 +1)))) -(def: peek-cursor +(def: peek_cursor Expression - (|> @cursor (_.at (last-index @cursor)))) + (|> @cursor (_.at (last_index @cursor)))) -(def: save-cursor! +(def: save_cursor! Statement (.let [cursor (|> @cursor (_.do "slice" (list)))] (_.statement (|> @savepoint (_.do "push" (list cursor)))))) -(def: restore-cursor! +(def: restore_cursor! Statement (_.set @cursor (|> @savepoint (_.do "pop" (list))))) -(def: fail-pm! _.break) +(def: fail_pm! _.break) -(def: (multi-pop-cursor! pops) +(def: (multi_pop_cursor! pops) (-> Nat Statement) (.let [popsJS (_.i32 (.int pops))] (_.statement (|> @cursor (_.do "splice" (list (|> @cursor ..length (_.- popsJS)) @@ -132,30 +133,30 @@ [(def: (<name> simple? idx) (-> Bit Nat Statement) ($_ _.then - (_.set @temp (|> idx <prep> .int _.i32 (//runtime.sum//get ..peek-cursor <flag>))) + (_.set @temp (|> idx <prep> .int _.i32 (//runtime.sum//get ..peek_cursor <flag>))) (.if simple? (_.when (_.= _.null @temp) - ..fail-pm!) + ..fail_pm!) (_.if (_.= _.null @temp) - ..fail-pm! - (push-cursor! @temp)))))] + ..fail_pm! + (push_cursor! @temp)))))] - [left-choice _.null (<|)] - [right-choice (_.string "") inc] + [left_choice _.null (<|)] + [right_choice (_.string "") inc] ) (def: (alternation pre! post!) (-> Statement Statement Statement) ($_ _.then - (_.do-while (_.boolean false) + (_.do_while (_.boolean false) ($_ _.then - ..save-cursor! + ..save_cursor! pre!)) ($_ _.then - ..restore-cursor! + ..restore_cursor! post!))) -(def: (optimized-pattern-matching recur pathP) +(def: (optimized_pattern_matching recur pathP) (-> (-> Path (Operation Statement)) (-> Path (Operation (Maybe Statement)))) (.case pathP @@ -164,59 +165,59 @@ (|> nextP recur (\ ///////phase.monad map (|>> (_.then (<choice> true idx)) #.Some)))]) - ([/////synthesis.simple-left-side ..left-choice] - [/////synthesis.simple-right-side ..right-choice]) + ([/////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)))) + (///////phase\wrap (#.Some (push_cursor! (_.at (_.i32 +0) ..peek_cursor)))) ## Extra optimization (^ (/////synthesis.path/seq (/////synthesis.member/left 0) - (/////synthesis.!bind-top register thenP))) + (/////synthesis.!bind_top register thenP))) (do ///////phase.monad [then! (recur thenP)] (wrap (#.Some ($_ _.then - (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor)) + (_.define (..register register) (_.at (_.i32 +0) ..peek_cursor)) then!)))) ## Extra optimization (^template [<pm> <getter>] [(^ (/////synthesis.path/seq (<pm> lefts) - (/////synthesis.!bind-top register thenP))) + (/////synthesis.!bind_top register thenP))) (do ///////phase.monad [then! (recur thenP)] (wrap (#.Some ($_ _.then - (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor)) + (_.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)) + (^ (/////synthesis.!bind_top register thenP)) (do ///////phase.monad [then! (recur thenP)] (wrap (#.Some ($_ _.then - (_.define (..register register) ..peek-and-pop-cursor) + (_.define (..register register) ..peek_and_pop_cursor) then!)))) - (^ (/////synthesis.!multi-pop nextP)) - (.let [[extra-pops nextP'] (////synthesis/case.count-pops nextP)] + (^ (/////synthesis.!multi_pop nextP)) + (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] (do ///////phase.monad [next! (recur nextP')] (wrap (#.Some ($_ _.then - (multi-pop-cursor! (n.+ 2 extra-pops)) + (multi_pop_cursor! (n.+ 2 extra_pops)) next!))))) _ (///////phase\wrap #.None))) -(def: (pattern-matching' statement expression archive) +(def: (pattern_matching' statement expression archive) (-> Phase! Phase Archive (-> Path (Operation Statement))) (function (recur pathP) (do ///////phase.monad - [outcome (optimized-pattern-matching recur pathP)] + [outcome (optimized_pattern_matching recur pathP)] (.case outcome (#.Some outcome) (wrap outcome) @@ -224,12 +225,12 @@ #.None (.case pathP #/////synthesis.Pop - (///////phase\wrap pop-cursor!) + (///////phase\wrap pop_cursor!) (#/////synthesis.Bind register) - (///////phase\wrap (_.define (..register register) ..peek-cursor)) + (///////phase\wrap (_.define (..register register) ..peek_cursor)) - (#/////synthesis.Bit-Fork when thenP elseP) + (#/////synthesis.Bit_Fork when thenP elseP) (do {! ///////phase.monad} [then! (recur thenP) else! (.case elseP @@ -237,25 +238,25 @@ (recur elseP) #.None - (wrap ..fail-pm!))] + (wrap ..fail_pm!))] (wrap (.if when - (_.if ..peek-cursor + (_.if ..peek_cursor then! else!) - (_.if ..peek-cursor + (_.if ..peek_cursor else! then!)))) - (#/////synthesis.I64-Fork cons) + (#/////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) + ..peek_cursor) then!]))) (#.Cons cons))] - (wrap (_.cond clauses ..fail-pm!))) + (wrap (_.cond clauses ..fail_pm!))) (^template [<tag> <format> <type>] [(<tag> cons) @@ -263,11 +264,11 @@ [cases (monad.map ! (function (_ [match then]) (\ ! map (|>> [(list (<format> match))]) (recur then))) (#.Cons cons))] - (wrap (_.switch ..peek-cursor + (wrap (_.switch ..peek_cursor cases - (#.Some ..fail-pm!))))]) - ([#/////synthesis.F64-Fork //primitive.f64 Frac] - [#/////synthesis.Text-Fork //primitive.text Text]) + (#.Some ..fail_pm!))))]) + ([#/////synthesis.F64_Fork //primitive.f64 Frac] + [#/////synthesis.Text_Fork //primitive.text Text]) (#/////synthesis.Then bodyS) (statement expression archive bodyS) @@ -275,12 +276,12 @@ (^template [<complex> <choice>] [(^ (<complex> idx)) (///////phase\wrap (<choice> false idx))]) - ([/////synthesis.side/left ..left-choice] - [/////synthesis.side/right ..right-choice]) + ([/////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)))]) + (///////phase\wrap (push_cursor! (<getter> (_.i32 (.int lefts)) ..peek_cursor)))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) @@ -293,24 +294,24 @@ ([/////synthesis.path/seq _.then] [/////synthesis.path/alt ..alternation])))))) -(def: (pattern-matching statement expression archive pathP) +(def: (pattern_matching statement expression archive pathP) (-> Phase! Phase Archive Path (Operation Statement)) (do ///////phase.monad - [pattern-matching! (pattern-matching' statement expression 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)))))) + (_.do_while (_.boolean false) + pattern_matching!) + (_.throw (_.string ////synthesis/case.pattern_matching_error)))))) (def: #export (case statement expression archive [valueS pathP]) (-> Phase! (Generator [Synthesis Path])) (do ///////phase.monad - [stack-init (expression archive valueS) - path! (pattern-matching statement expression archive pathP) + [stack_init (expression archive valueS) + path! (pattern_matching statement expression archive pathP) #let [closure (<| (_.closure (list)) ($_ _.then (_.declare @temp) - (_.define @cursor (_.array (list stack-init))) + (_.define @cursor (_.array (list stack_init))) (_.define @savepoint (_.array (list))) path!))]] (wrap (_.apply/* closure (list))))) @@ -318,10 +319,10 @@ (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)] + [stack_init (expression archive valueS) + path! (pattern_matching statement expression archive pathP)] (wrap ($_ _.then (_.declare @temp) - (_.define @cursor (_.array (list stack-init))) + (_.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 c939b36a6..0d47e9fe8 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 @@ -35,11 +35,11 @@ argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* functionO argsO+)))) -(def: (with-closure @self inits function-body) +(def: (with_closure @self inits function_body) (-> Var (List Expression) Statement [Statement Expression]) (case inits #.Nil - [(_.function! @self (list) function-body) + [(_.function! @self (list) function_body) @self] _ @@ -48,7 +48,7 @@ [(_.function! @self (|> (list.enumeration inits) (list\map (|>> product.left capture))) - (_.return (_.function @self (list) function-body))) + (_.return (_.function @self (list) function_body))) (_.apply/* @self inits)]))) (def: @curried (_.var "curried")) @@ -58,63 +58,63 @@ (def: @@arguments (_.var "arguments")) -(def: (@scope function-name) +(def: (@scope function_name) (-> Context Text) - (format (///reference.artifact function-name) "_scope")) + (format (///reference.artifact function_name) "_scope")) (def: #export (function statement expression archive [environment arity bodyS]) (-> Phase! (Generator (Abstraction Synthesis))) (do {! ///////phase.monad} - [[function-name body!] (/////generation.with-new-context archive + [[function_name body!] (/////generation.with_new_context archive (do ! [scope (\ ! map ..@scope (/////generation.context archive))] - (/////generation.with-anchor [1 scope] + (/////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) + @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)))) - initialize-self! (_.define (//case.register 0) @self) + initialize_self! (_.define (//case.register 0) @self) initialize! (list\fold (.function (_ post pre!) ($_ _.then pre! (_.define (..input post) (_.at (_.i32 (.int post)) @@arguments)))) - initialize-self! + initialize_self! (list.indices arity))] environment (monad.map ! (expression archive) environment) - #let [[definition instantiation] (with-closure @self environment + #let [[definition instantiation] (with_closure @self environment ($_ _.then - (_.define @num-args (_.the "length" @@arguments)) - (_.cond (list [(|> @num-args (_.= arityO)) + (_.define @num_args (_.the "length" @@arguments)) + (_.cond (list [(|> @num_args (_.= arityO)) ($_ _.then initialize! - (_.with-label (_.label @scope) - (_.do-while (_.boolean true) + (_.with_label (_.label @scope) + (_.do_while (_.boolean true) body!)))] - [(|> @num-args (_.> arityO)) - (let [arity-inputs (|> (_.array (list)) + [(|> @num_args (_.> arityO)) + (let [arity_inputs (|> (_.array (list)) (_.the "slice") (_.do "call" (list @@arguments (_.i32 +0) arityO))) - extra-inputs (|> (_.array (list)) + 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)) + (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) + (_.define @curried all_inputs) (_.return (_.closure (list) - (let [@missing all-inputs] - (_.return (apply-poly (_.do "concat" (list @missing) @curried) + (let [@missing all_inputs] + (_.return (apply_poly (_.do "concat" (list @missing) @curried) @self)))))))) ))] _ (/////generation.execute! definition) - _ (/////generation.save! (%.nat (product.right function-name)) definition)] + _ (/////generation.save! (%.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 29cdc1180..bbeaca725 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 @@ -6,10 +6,11 @@ ["." product] ["." text ["%" format (#+ format)]] - [number - ["n" nat]] [collection ["." list ("#\." functor fold)]]] + [math + [number + ["n" nat]]] [target ["_" js (#+ Computation Var Expression Statement)]]] ["." // #_ @@ -51,11 +52,11 @@ (do {! ///////phase.monad} [@scope (\ ! map ..@scope /////generation.next) initsO+ (monad.map ! (expression archive) initsS+) - body! (/////generation.with-anchor [start @scope] + body! (/////generation.with_anchor [start @scope] (statement expression archive bodyS))] (wrap (..setup true start initsO+ - (_.with-label (_.label @scope) - (_.do-while (_.boolean true) + (_.with_label (_.label @scope) + (_.do_while (_.boolean true) body!))))))) (def: #export (scope statement expression archive [start initsS+ bodyS]) @@ -70,14 +71,14 @@ (do {! ///////phase.monad} [@scope (\ ! map ..@scope /////generation.next) initsO+ (monad.map ! (expression archive) initsS+) - body! (/////generation.with-anchor [start @scope] + body! (/////generation.with_anchor [start @scope] (statement expression archive bodyS)) #let [closure (_.closure (|> initsS+ list.enumeration (list\map (|>> product.left (n.+ start) //case.register))) - (_.with-label (_.label @scope) - (_.do-while (_.boolean true) + (_.with_label (_.label @scope) + (_.do_while (_.boolean true) body!)))]] (wrap (_.apply/* closure initsO+))))) @@ -95,4 +96,4 @@ list.enumeration (list\map (function (_ [idx _]) (_.at (_.i32 (.int idx)) @temp)))) - (_.continue-at (_.label @scope))))))) + (_.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 d8859f767..119796a73 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 @@ -1,5 +1,6 @@ (.module: [lux #* + ["." meta] [abstract ["." monad (#+ do)]] [control @@ -8,17 +9,18 @@ ["s" code]]] [data ["." product] - [number (#+ hex) - ["." i64]] ["." text ("#\." hash) ["%" format (#+ format)] ["." encoding]] [collection ["." list ("#\." functor)] ["." row]]] - ["." macro - ["." code] - [syntax (#+ syntax:)]] + [macro + [syntax (#+ syntax:)] + ["." code]] + [math + [number (#+ hex) + ["." i64]]] [target ["_" js (#+ Expression Var Computation Statement)]] [tool @@ -64,11 +66,11 @@ (def: #export high (-> (I64 Any) (I64 Any)) - (i64.logic-right-shift 32)) + (i64.logic_right_shift 32)) (def: #export low (-> (I64 Any) (I64 Any)) - (let [mask (dec (i64.left-shift 32 1))] + (let [mask (dec (i64.left_shift 32 1))] (|>> (i64.and mask)))) (def: #export unit Computation (_.string /////synthesis.unit)) @@ -83,67 +85,67 @@ (-> Var (-> Var Expression) Statement) (_.define name (definition name))) -(syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))} +(syntax: #export (with_vars {vars (s.tuple (p.some s.local_identifier))} body) - (do {! macro.monad} - [ids (monad.seq ! (list.repeat (list.size vars) macro.count))] + (do {! meta.monad} + [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] (wrap (list (` (let [(~+ (|> vars (list.zip/2 ids) (list\map (function (_ [id var]) - (list (code.local-identifier var) + (list (code.local_identifier var) (` (_.var (~ (code.text (format "v" (%.nat id))))))))) list.concat))] (~ body))))))) -(def: (runtime-name name) +(def: (runtime_name name) (-> Text [Code Code]) (let [identifier (format ..prefix "_" (%.nat $.version) "_" (%.nat (text\hash name)))] [(` (_.var (~ (code.text identifier)))) - (code.local-identifier identifier)])) + (code.local_identifier identifier)])) -(syntax: (runtime: {declaration (p.or s.local-identifier - (s.form (p.and s.local-identifier - (p.some s.local-identifier))))} +(syntax: (runtime: {declaration (p.or s.local_identifier + (s.form (p.and s.local_identifier + (p.some s.local_identifier))))} code) (case declaration (#.Left name) - (macro.with-gensyms [g!_] - (let [[runtime-nameC runtime-nameC!] (..runtime-name name) - nameC (code.local-identifier name)] - (wrap (list (` (def: (~ runtime-nameC!) + (meta.with_gensyms [g!_] + (let [[runtime_nameC runtime_nameC!] (..runtime_name name) + nameC (code.local_identifier name)] + (wrap (list (` (def: (~ runtime_nameC!) Var - (~ runtime-nameC))) + (~ runtime_nameC))) (` (def: #export (~ nameC) - (~ runtime-nameC!))) + (~ runtime_nameC!))) - (` (def: (~ (code.local-identifier (format "@" name))) + (` (def: (~ (code.local_identifier (format "@" name))) Statement - (..feature (~ runtime-nameC) + (..feature (~ runtime_nameC) (function ((~ g!_) (~ nameC)) (~ code))))))))) (#.Right [name inputs]) - (macro.with-gensyms [g!_] - (let [[runtime-nameC runtime-nameC!] (..runtime-name name) - nameC (code.local-identifier name) - code-nameC (code.local-identifier (format "@" name)) - inputsC (list\map code.local-identifier inputs) - inputs-typesC (list\map (function.constant (` _.Expression)) inputs)] - (wrap (list (` (def: ((~ runtime-nameC!) (~+ inputsC)) - (-> (~+ inputs-typesC) Computation) - (_.apply/* (~ runtime-nameC) (list (~+ inputsC))))) + (meta.with_gensyms [g!_] + (let [[runtime_nameC runtime_nameC!] (..runtime_name name) + nameC (code.local_identifier name) + code_nameC (code.local_identifier (format "@" name)) + inputsC (list\map code.local_identifier inputs) + inputs_typesC (list\map (function.constant (` _.Expression)) inputs)] + (wrap (list (` (def: ((~ runtime_nameC!) (~+ inputsC)) + (-> (~+ inputs_typesC) Computation) + (_.apply/* (~ runtime_nameC) (list (~+ inputsC))))) (` (def: #export (~ nameC) - (~ runtime-nameC!))) + (~ runtime_nameC!))) - (` (def: (~ (code.local-identifier (format "@" name))) + (` (def: (~ (code.local_identifier (format "@" name))) Statement - (..feature (~ runtime-nameC) + (..feature (~ runtime_nameC) (function ((~ g!_) (~ g!_)) - (..with-vars [(~+ inputsC)] + (..with_vars [(~+ inputsC)] (_.function (~ g!_) (list (~+ inputsC)) (~ code))))))))))))) @@ -151,80 +153,80 @@ (-> Expression Computation) (_.the "length")) -(def: last-index +(def: last_index (-> Expression Computation) (|>> ..length (_.- (_.i32 +1)))) -(def: (last-element tuple) - (_.at (..last-index tuple) +(def: (last_element tuple) + (_.at (..last_index tuple) tuple)) -(with-expansions [<recur> (as-is ($_ _.then - (_.set lefts (_.- last-index-right lefts)) - (_.set tuple (_.at last-index-right tuple))))] +(with_expansions [<recur> (as_is ($_ _.then + (_.set lefts (_.- last_index_right lefts)) + (_.set tuple (_.at last_index_right tuple))))] (runtime: (tuple//left lefts tuple) - (with-vars [last-index-right] + (with_vars [last_index_right] (<| (_.while (_.boolean true)) ($_ _.then - (_.define last-index-right (..last-index tuple)) - (_.if (_.> lefts last-index-right) + (_.define last_index_right (..last_index tuple)) + (_.if (_.> lefts last_index_right) ## No need for recursion (_.return (_.at lefts tuple)) ## Needs recursion <recur>))))) (runtime: (tuple//right lefts tuple) - (with-vars [last-index-right right-index] + (with_vars [last_index_right right_index] (<| (_.while (_.boolean true)) ($_ _.then - (_.define last-index-right (..last-index tuple)) - (_.define right-index (_.+ (_.i32 +1) lefts)) - (_.cond (list [(_.= last-index-right right-index) - (_.return (_.at right-index tuple))] - [(_.> last-index-right right-index) + (_.define last_index_right (..last_index tuple)) + (_.define right_index (_.+ (_.i32 +1) lefts)) + (_.cond (list [(_.= last_index_right right_index) + (_.return (_.at right_index tuple))] + [(_.> last_index_right right_index) ## Needs recursion. <recur>]) - (_.return (_.do "slice" (list right-index) tuple))) + (_.return (_.do "slice" (list right_index) tuple))) ))))) -(def: #export variant-tag-field "_lux_tag") -(def: #export variant-flag-field "_lux_flag") -(def: #export variant-value-field "_lux_value") +(def: #export variant_tag_field "_lux_tag") +(def: #export variant_flag_field "_lux_flag") +(def: #export variant_value_field "_lux_value") (runtime: (variant//create tag last? value) - (_.return (_.object (list [..variant-tag-field tag] - [..variant-flag-field last?] - [..variant-value-field value])))) + (_.return (_.object (list [..variant_tag_field tag] + [..variant_flag_field last?] + [..variant_value_field value])))) (def: #export (variant tag last? value) (-> Expression Expression Expression Computation) (..variant//create tag last? value)) -(runtime: (sum//get sum wants-last wanted-tag) - (let [no-match! (_.return _.null) - sum-tag (|> sum (_.the ..variant-tag-field)) - sum-flag (|> sum (_.the ..variant-flag-field)) - sum-value (|> sum (_.the ..variant-value-field)) - is-last? (_.= ..unit sum-flag) - extact-match! (_.return sum-value) - test-recursion! (_.if is-last? +(runtime: (sum//get sum wants_last wanted_tag) + (let [no_match! (_.return _.null) + sum_tag (|> sum (_.the ..variant_tag_field)) + sum_flag (|> sum (_.the ..variant_flag_field)) + sum_value (|> sum (_.the ..variant_value_field)) + is_last? (_.= ..unit sum_flag) + extact_match! (_.return sum_value) + test_recursion! (_.if is_last? ## Must recurse. ($_ _.then - (_.set wanted-tag (_.- sum-tag wanted-tag)) - (_.set sum sum-value)) - no-match!) - extrac-sub-variant! (_.return (..variant (_.- wanted-tag sum-tag) sum-flag sum-value))] + (_.set wanted_tag (_.- sum_tag wanted_tag)) + (_.set sum sum_value)) + no_match!) + extrac_sub_variant! (_.return (..variant (_.- wanted_tag sum_tag) sum_flag sum_value))] (<| (_.while (_.boolean true)) - (_.cond (list [(_.= wanted-tag sum-tag) - (_.if (_.= wants-last sum-flag) - extact-match! - test-recursion!)] - [(_.< wanted-tag sum-tag) - test-recursion!] - [(_.and (_.> wanted-tag sum-tag) - (_.= ..unit wants-last)) - extrac-sub-variant!]) - no-match!)))) + (_.cond (list [(_.= wanted_tag sum_tag) + (_.if (_.= wants_last sum_flag) + extact_match! + test_recursion!)] + [(_.< wanted_tag sum_tag) + test_recursion!] + [(_.and (_.> wanted_tag sum_tag) + (_.= ..unit wants_last)) + extrac_sub_variant!]) + no_match!)))) (def: none Computation @@ -252,16 +254,16 @@ )) (runtime: (lux//try op) - (with-vars [ex] + (with_vars [ex] (_.try (_.return (..right (_.apply/1 op ..unit))) [ex (_.return (..left (|> ex (_.do "toString" (list)))))]))) -(runtime: (lux//program-args inputs) - (with-vars [output idx] +(runtime: (lux//program_args inputs) + (with_vars [output idx] ($_ _.then (_.define output ..none) (_.for idx - (..last-index inputs) + (..last_index inputs) (_.>= (_.i32 +0) idx) (_.-- idx) (_.set output (..some (_.array (list (_.at idx inputs) @@ -272,18 +274,18 @@ Statement ($_ _.then @lux//try - @lux//program-args + @lux//program_args )) -(def: #export i64-low-field Text "_lux_low") -(def: #export i64-high-field Text "_lux_high") +(def: #export i64_low_field Text "_lux_low") +(def: #export i64_high_field Text "_lux_high") (runtime: (i64//new high low) - (_.return (_.object (list [..i64-high-field high] - [..i64-low-field low])))) + (_.return (_.object (list [..i64_high_field high] + [..i64_low_field low])))) (runtime: i64//2^16 - (_.left-shift (_.i32 +16) (_.i32 +1))) + (_.left_shift (_.i32 +16) (_.i32 +1))) (runtime: i64//2^32 (_.* i64//2^16 i64//2^16)) @@ -294,14 +296,14 @@ (runtime: i64//2^63 (|> i64//2^64 (_./ (_.i32 +2)))) -(runtime: (i64//unsigned-low i64) - (_.return (_.? (|> i64 (_.the ..i64-low-field) (_.>= (_.i32 +0))) - (|> i64 (_.the ..i64-low-field)) - (|> i64 (_.the ..i64-low-field) (_.+ i64//2^32))))) +(runtime: (i64//unsigned_low i64) + (_.return (_.? (|> i64 (_.the ..i64_low_field) (_.>= (_.i32 +0))) + (|> i64 (_.the ..i64_low_field)) + (|> i64 (_.the ..i64_low_field) (_.+ i64//2^32))))) -(runtime: (i64//to-number i64) - (_.return (|> i64 (_.the ..i64-high-field) (_.* i64//2^32) - (_.+ (i64//unsigned-low i64))))) +(runtime: (i64//to_number i64) + (_.return (|> i64 (_.the ..i64_high_field) (_.* i64//2^32) + (_.+ (i64//unsigned_low i64))))) (runtime: i64//zero (i64//new (_.i32 +0) (_.i32 +0))) @@ -316,20 +318,20 @@ (i64//new (_.i32 +0) (_.i32 +1))) (runtime: (i64//= reference sample) - (_.return (_.and (_.= (_.the ..i64-high-field reference) - (_.the ..i64-high-field sample)) - (_.= (_.the ..i64-low-field reference) - (_.the ..i64-low-field sample))))) + (_.return (_.and (_.= (_.the ..i64_high_field reference) + (_.the ..i64_high_field sample)) + (_.= (_.the ..i64_low_field reference) + (_.the ..i64_low_field sample))))) (runtime: (i64//+ parameter subject) - (let [up-16 (_.left-shift (_.i32 +16)) - high-16 (_.logic-right-shift (_.i32 +16)) - low-16 (_.bit-and (_.i32 (hex "+FFFF"))) - hh (|>> (_.the ..i64-high-field) high-16) - hl (|>> (_.the ..i64-high-field) low-16) - lh (|>> (_.the ..i64-low-field) high-16) - ll (|>> (_.the ..i64-low-field) low-16)] - (with-vars [l48 l32 l16 l00 + (let [up_16 (_.left_shift (_.i32 +16)) + high_16 (_.logic_right_shift (_.i32 +16)) + low_16 (_.bit_and (_.i32 (hex "+FFFF"))) + hh (|>> (_.the ..i64_high_field) high_16) + hl (|>> (_.the ..i64_high_field) low_16) + lh (|>> (_.the ..i64_low_field) high_16) + ll (|>> (_.the ..i64_low_field) low_16)] + (with_vars [l48 l32 l16 l00 r48 r32 r16 r00 x48 x32 x16 x00] ($_ _.then @@ -344,34 +346,34 @@ (_.define r00 (ll parameter)) (_.define x00 (_.+ l00 r00)) - (_.define x16 (high-16 x00)) - (_.set x00 (low-16 x00)) + (_.define x16 (high_16 x00)) + (_.set x00 (low_16 x00)) (_.set x16 (|> x16 (_.+ l16) (_.+ r16))) - (_.define x32 (high-16 x16)) - (_.set x16 (low-16 x16)) + (_.define x32 (high_16 x16)) + (_.set x16 (low_16 x16)) (_.set x32 (|> x32 (_.+ l32) (_.+ r32))) - (_.define x48 (|> (high-16 x32) (_.+ l48) (_.+ r48) low-16)) - (_.set x32 (low-16 x32)) + (_.define x48 (|> (high_16 x32) (_.+ l48) (_.+ r48) low_16)) + (_.set x32 (low_16 x32)) - (_.return (i64//new (_.bit-or (up-16 x48) x32) - (_.bit-or (up-16 x16) x00))) + (_.return (i64//new (_.bit_or (up_16 x48) x32) + (_.bit_or (up_16 x16) x00))) )))) (template [<name> <op>] [(runtime: (<name> subject parameter) - (_.return (i64//new (<op> (_.the ..i64-high-field subject) - (_.the ..i64-high-field parameter)) - (<op> (_.the ..i64-low-field subject) - (_.the ..i64-low-field parameter)))))] - - [i64//xor _.bit-xor] - [i64//or _.bit-or] - [i64//and _.bit-and] + (_.return (i64//new (<op> (_.the ..i64_high_field subject) + (_.the ..i64_high_field parameter)) + (<op> (_.the ..i64_low_field subject) + (_.the ..i64_low_field parameter)))))] + + [i64//xor _.bit_xor] + [i64//or _.bit_or] + [i64//and _.bit_and] ) (runtime: (i64//not value) - (_.return (i64//new (_.bit-not (_.the ..i64-high-field value)) - (_.bit-not (_.the ..i64-low-field value))))) + (_.return (i64//new (_.bit_not (_.the ..i64_high_field value)) + (_.bit_not (_.the ..i64_low_field value))))) (runtime: (i64//negate value) (_.if (i64//= i64//min value) @@ -381,71 +383,71 @@ (runtime: i64//-one (i64//negate i64//one)) -(runtime: (i64//from-number value) - (_.cond (list [(_.not-a-number? value) +(runtime: (i64//from_number value) + (_.cond (list [(_.not_a_number? value) (_.return i64//zero)] [(_.<= (_.negate i64//2^63) value) (_.return i64//min)] [(|> value (_.+ (_.i32 +1)) (_.>= i64//2^63)) (_.return i64//max)] [(|> value (_.< (_.i32 +0))) - (_.return (|> value _.negate i64//from-number i64//negate))]) - (_.return (i64//new (|> value (_./ i64//2^32) _.to-i32) - (|> value (_.% i64//2^32) _.to-i32))))) + (_.return (|> value _.negate i64//from_number i64//negate))]) + (_.return (i64//new (|> value (_./ i64//2^32) _.to_i32) + (|> value (_.% i64//2^32) _.to_i32))))) -(def: (cap-shift! shift) +(def: (cap_shift! shift) (-> Var Statement) - (_.set shift (|> shift (_.bit-and (_.i32 +63))))) + (_.set shift (|> shift (_.bit_and (_.i32 +63))))) -(def: (no-shift! shift input) +(def: (no_shift! shift input) (-> Var Var [Expression Statement]) [(|> shift (_.= (_.i32 +0))) (_.return input)]) -(def: small-shift? +(def: small_shift? (-> Var Expression) (|>> (_.< (_.i32 +32)))) -(runtime: (i64//left-shift input shift) +(runtime: (i64//left_shift input shift) ($_ _.then - (..cap-shift! shift) - (_.cond (list (..no-shift! shift input) - [(..small-shift? shift) - (let [high (_.bit-or (|> input (_.the ..i64-high-field) (_.left-shift shift)) - (|> input (_.the ..i64-low-field) (_.logic-right-shift (_.- shift (_.i32 +32))))) - low (|> input (_.the ..i64-low-field) (_.left-shift shift))] + (..cap_shift! shift) + (_.cond (list (..no_shift! shift input) + [(..small_shift? shift) + (let [high (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift shift)) + (|> input (_.the ..i64_low_field) (_.logic_right_shift (_.- shift (_.i32 +32))))) + low (|> input (_.the ..i64_low_field) (_.left_shift shift))] (_.return (i64//new high low)))]) - (let [high (|> input (_.the ..i64-low-field) (_.left-shift (_.- (_.i32 +32) shift)))] + (let [high (|> input (_.the ..i64_low_field) (_.left_shift (_.- (_.i32 +32) shift)))] (_.return (i64//new high (_.i32 +0))))))) -(runtime: (i64//arithmetic-right-shift input shift) +(runtime: (i64//arithmetic_right_shift input shift) ($_ _.then - (..cap-shift! shift) - (_.cond (list (..no-shift! shift input) - [(..small-shift? shift) - (let [high (|> input (_.the ..i64-high-field) (_.arithmetic-right-shift shift)) - low (|> input (_.the ..i64-low-field) (_.logic-right-shift shift) - (_.bit-or (|> input (_.the ..i64-high-field) (_.left-shift (_.- shift (_.i32 +32))))))] + (..cap_shift! shift) + (_.cond (list (..no_shift! shift input) + [(..small_shift? shift) + (let [high (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift shift)) + low (|> input (_.the ..i64_low_field) (_.logic_right_shift shift) + (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] (_.return (i64//new high low)))]) - (let [high (_.? (|> input (_.the ..i64-high-field) (_.>= (_.i32 +0))) + (let [high (_.? (|> input (_.the ..i64_high_field) (_.>= (_.i32 +0))) (_.i32 +0) (_.i32 -1)) - low (|> input (_.the ..i64-high-field) (_.arithmetic-right-shift (_.- (_.i32 +32) shift)))] + low (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift (_.- (_.i32 +32) shift)))] (_.return (i64//new high low)))))) -(runtime: (i64//logic-right-shift input shift) +(runtime: (i64//logic_right_shift input shift) ($_ _.then - (..cap-shift! shift) - (_.cond (list (..no-shift! shift input) - [(..small-shift? shift) - (let [high (|> input (_.the ..i64-high-field) (_.logic-right-shift shift)) - low (|> input (_.the ..i64-low-field) (_.logic-right-shift shift) - (_.bit-or (|> input (_.the ..i64-high-field) (_.left-shift (_.- shift (_.i32 +32))))))] + (..cap_shift! shift) + (_.cond (list (..no_shift! shift input) + [(..small_shift? shift) + (let [high (|> input (_.the ..i64_high_field) (_.logic_right_shift shift)) + low (|> input (_.the ..i64_low_field) (_.logic_right_shift shift) + (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] (_.return (i64//new high low)))] [(|> shift (_.= (_.i32 +32))) - (_.return (i64//new (_.i32 +0) (|> input (_.the ..i64-high-field))))]) + (_.return (i64//new (_.i32 +0) (|> input (_.the ..i64_high_field))))]) (_.return (i64//new (_.i32 +0) - (|> input (_.the ..i64-high-field) (_.logic-right-shift (_.- (_.i32 +32) shift)))))))) + (|> input (_.the ..i64_high_field) (_.logic_right_shift (_.- (_.i32 +32) shift)))))))) (def: runtime//bit Statement @@ -454,16 +456,16 @@ @i64//or @i64//xor @i64//not - @i64//left-shift - @i64//arithmetic-right-shift - @i64//logic-right-shift + @i64//left_shift + @i64//arithmetic_right_shift + @i64//logic_right_shift )) (runtime: (i64//- parameter subject) (_.return (i64//+ (i64//negate parameter) subject))) (runtime: (i64//* parameter subject) - (let [negative? (|>> (_.the ..i64-high-field) (_.< (_.i32 +0)))] + (let [negative? (|>> (_.the ..i64_high_field) (_.< (_.i32 +0)))] (_.cond (list [(negative? subject) (_.if (negative? parameter) ## Both are negative @@ -474,14 +476,14 @@ ## Parameter is negative (_.return (i64//negate (i64//* (i64//negate parameter) subject)))]) ## Both are positive - (let [up-16 (_.left-shift (_.i32 +16)) - high-16 (_.logic-right-shift (_.i32 +16)) - low-16 (_.bit-and (_.i32 (hex "+FFFF"))) - hh (|>> (_.the ..i64-high-field) high-16) - hl (|>> (_.the ..i64-high-field) low-16) - lh (|>> (_.the ..i64-low-field) high-16) - ll (|>> (_.the ..i64-low-field) low-16)] - (with-vars [l48 l32 l16 l00 + (let [up_16 (_.left_shift (_.i32 +16)) + high_16 (_.logic_right_shift (_.i32 +16)) + low_16 (_.bit_and (_.i32 (hex "+FFFF"))) + hh (|>> (_.the ..i64_high_field) high_16) + hl (|>> (_.the ..i64_high_field) low_16) + lh (|>> (_.the ..i64_low_field) high_16) + ll (|>> (_.the ..i64_low_field) low_16)] + (with_vars [l48 l32 l16 l00 r48 r32 r16 r00 x48 x32 x16 x00] ($_ _.then @@ -496,35 +498,35 @@ (_.define r00 (ll parameter)) (_.define x00 (_.* l00 r00)) - (_.define x16 (high-16 x00)) - (_.set x00 (low-16 x00)) + (_.define x16 (high_16 x00)) + (_.set x00 (low_16 x00)) (_.set x16 (|> x16 (_.+ (_.* l16 r00)))) - (_.define x32 (high-16 x16)) (_.set x16 (low-16 x16)) + (_.define x32 (high_16 x16)) (_.set x16 (low_16 x16)) (_.set x16 (|> x16 (_.+ (_.* l00 r16)))) - (_.set x32 (|> x32 (_.+ (high-16 x16)))) (_.set x16 (low-16 x16)) + (_.set x32 (|> x32 (_.+ (high_16 x16)))) (_.set x16 (low_16 x16)) (_.set x32 (|> x32 (_.+ (_.* l32 r00)))) - (_.define x48 (high-16 x32)) (_.set x32 (low-16 x32)) + (_.define x48 (high_16 x32)) (_.set x32 (low_16 x32)) (_.set x32 (|> x32 (_.+ (_.* l16 r16)))) - (_.set x48 (|> x48 (_.+ (high-16 x32)))) (_.set x32 (low-16 x32)) + (_.set x48 (|> x48 (_.+ (high_16 x32)))) (_.set x32 (low_16 x32)) (_.set x32 (|> x32 (_.+ (_.* l00 r32)))) - (_.set x48 (|> x48 (_.+ (high-16 x32)))) (_.set x32 (low-16 x32)) + (_.set x48 (|> x48 (_.+ (high_16 x32)))) (_.set x32 (low_16 x32)) (_.set x48 (|> x48 (_.+ (_.* l48 r00)) (_.+ (_.* l32 r16)) (_.+ (_.* l16 r32)) (_.+ (_.* l00 r48)) - low-16)) + low_16)) - (_.return (i64//new (_.bit-or (up-16 x48) x32) - (_.bit-or (up-16 x16) x00))) + (_.return (i64//new (_.bit_or (up_16 x48) x32) + (_.bit_or (up_16 x16) x00))) )))))) (runtime: (i64//< parameter subject) - (let [negative? (|>> (_.the ..i64-high-field) (_.< (_.i32 +0)))] - (with-vars [-subject? -parameter?] + (let [negative? (|>> (_.the ..i64_high_field) (_.< (_.i32 +0)))] + (with_vars [-subject? -parameter?] ($_ _.then (_.define -subject? (negative? subject)) (_.define -parameter? (negative? parameter)) @@ -542,12 +544,12 @@ (runtime: (i64/// parameter subject) (let [negative? (function (_ value) (i64//< i64//zero value)) - valid-division-check [(i64//= i64//zero parameter) + valid_division_check [(i64//= i64//zero parameter) (_.throw (_.string "Cannot divide by zero!"))] - short-circuit-check [(i64//= i64//zero subject) + short_circuit_check [(i64//= i64//zero subject) (_.return i64//zero)]] - (_.cond (list valid-division-check - short-circuit-check + (_.cond (list valid_division_check + short_circuit_check [(i64//= i64//min subject) (_.cond (list [(_.or (i64//= i64//one parameter) @@ -555,10 +557,10 @@ (_.return i64//min)] [(i64//= i64//min parameter) (_.return i64//one)]) - (with-vars [approximation] - (let [subject/2 (i64//arithmetic-right-shift subject (_.i32 +1))] + (with_vars [approximation] + (let [subject/2 (i64//arithmetic_right_shift subject (_.i32 +1))] ($_ _.then - (_.define approximation (i64//left-shift (i64/// parameter + (_.define approximation (i64//left_shift (i64/// parameter subject/2) (_.i32 +1))) (_.if (i64//= i64//zero approximation) @@ -583,17 +585,17 @@ [(negative? parameter) (_.return (i64//negate (i64/// (i64//negate parameter) subject)))]) - (with-vars [result remainder] + (with_vars [result remainder] ($_ _.then (_.define result i64//zero) (_.define remainder subject) (_.while (i64//<= remainder parameter) - (with-vars [approximate approximate-result approximate-remainder log2 delta] - (let [approximate-result' (i64//from-number approximate) - approx-remainder (i64//* parameter approximate-result)] + (with_vars [approximate approximate_result approximate_remainder log2 delta] + (let [approximate_result' (i64//from_number approximate) + approx_remainder (i64//* parameter approximate_result)] ($_ _.then - (_.define approximate (|> (i64//to-number remainder) - (_./ (i64//to-number parameter)) + (_.define approximate (|> (i64//to_number remainder) + (_./ (i64//to_number parameter)) (_.apply/1 (_.var "Math.floor")) (_.apply/2 (_.var "Math.max") (_.i32 +1)))) (_.define log2 (|> approximate @@ -606,20 +608,20 @@ (_.i32 +2) (_.- (_.i32 +48) log2)))) - (_.define approximate-result approximate-result') - (_.define approximate-remainder approx-remainder) - (_.while (_.or (negative? approximate-remainder) - (i64//< approximate-remainder + (_.define approximate_result approximate_result') + (_.define approximate_remainder approx_remainder) + (_.while (_.or (negative? approximate_remainder) + (i64//< approximate_remainder remainder)) ($_ _.then (_.set approximate (_.- delta approximate)) - (_.set approximate-result approximate-result') - (_.set approximate-remainder approx-remainder))) - (_.set result (i64//+ (_.? (i64//= i64//zero approximate-result) + (_.set approximate_result approximate_result') + (_.set approximate_remainder approx_remainder))) + (_.set result (i64//+ (_.? (i64//= i64//zero approximate_result) i64//one - approximate-result) + approximate_result) result)) - (_.set remainder (i64//- approximate-remainder remainder)))))) + (_.set remainder (i64//- approximate_remainder remainder)))))) (_.return result))) ))) @@ -636,7 +638,7 @@ @i64//2^32 @i64//2^64 @i64//2^63 - @i64//unsigned-low + @i64//unsigned_low @i64//new @i64//zero @i64//min @@ -645,8 +647,8 @@ @i64//= @i64//+ @i64//negate - @i64//to-number - @i64//from-number + @i64//to_number + @i64//from_number @i64//- @i64//* @i64//< @@ -656,24 +658,24 @@ )) (runtime: (text//index start part text) - (with-vars [idx] + (with_vars [idx] ($_ _.then - (_.define idx (|> text (_.do "indexOf" (list part (i64//to-number start))))) + (_.define idx (|> text (_.do "indexOf" (list part (i64//to_number start))))) (_.if (_.= (_.i32 -1) idx) (_.return ..none) - (_.return (..some (i64//from-number idx))))))) + (_.return (..some (i64//from_number idx))))))) (runtime: (text//clip start end text) - (_.return (|> text (_.do "substring" (list (_.the ..i64-low-field start) - (_.the ..i64-low-field end)))))) + (_.return (|> text (_.do "substring" (list (_.the ..i64_low_field start) + (_.the ..i64_low_field end)))))) (runtime: (text//char idx text) - (with-vars [result] + (with_vars [result] ($_ _.then - (_.define result (|> text (_.do "charCodeAt" (list (_.the ..i64-low-field idx))))) - (_.if (_.not-a-number? result) + (_.define result (|> text (_.do "charCodeAt" (list (_.the ..i64_low_field idx))))) + (_.if (_.not_a_number? result) (_.throw (_.string "[Lux Error] Cannot get char from text.")) - (_.return (i64//from-number result)))))) + (_.return (i64//from_number result)))))) (def: runtime//text Statement @@ -687,15 +689,15 @@ (let [console (_.var "console") print (_.var "print") end! (_.return ..unit)] - (_.cond (list [(|> console _.type-of (_.= (_.string "undefined")) _.not + (_.cond (list [(|> console _.type_of (_.= (_.string "undefined")) _.not (_.and (_.the "log" console))) ($_ _.then (_.statement (|> console (_.do "log" (list message)))) end!)] - [(|> print _.type-of (_.= (_.string "undefined")) _.not) + [(|> print _.type_of (_.= (_.string "undefined")) _.not) ($_ _.then (_.statement (_.apply/1 print (_.? (_.= (_.string "string") - (_.type-of message)) + (_.type_of message)) message (_.apply/1 (_.var "JSON.stringify") message)))) end!)]) @@ -712,7 +714,7 @@ )) (runtime: (js//get object field) - (with-vars [temp] + (with_vars [temp] ($_ _.then (_.define temp (_.at field object)) (_.if (_.= _.undefined temp) @@ -739,12 +741,12 @@ (runtime: (array//write idx value array) ($_ _.then - (_.set (_.at (_.the ..i64-low-field idx) array) value) + (_.set (_.at (_.the ..i64_low_field idx) array) value) (_.return array))) (runtime: (array//delete idx array) ($_ _.then - (_.delete (_.at (_.the ..i64-low-field idx) array)) + (_.delete (_.at (_.the ..i64_low_field idx) array)) (_.return array))) (def: runtime//array diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux index 543b2682a..1dd13c664 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux @@ -38,50 +38,50 @@ (type: (Action ! a) (! (Try a))) -(def: (write-artifact monad file-system static context) +(def: (write_artifact monad file_system static context) (All [!] (-> (Monad !) (file.System !) Static Context (Action ! Binary))) (do (try.with monad) [artifact (let [[module artifact] context] - (!.use (\ file-system file) [(io.artifact file-system static module (%.nat artifact))]))] + (!.use (\ file_system file) [(io.artifact file_system static module (%.nat artifact))]))] (!.use (\ artifact content) []))) -(def: (write-module monad file-system static sequence [module artifacts] so-far) +(def: (write_module monad file_system static sequence [module artifacts] so_far) (All [! directive] (-> (Monad !) (file.System !) Static (-> directive directive directive) [archive.ID (List artifact.ID)] directive (Action ! directive))) (monad.fold (:assume (try.with monad)) - (function (_ artifact so-far) + (function (_ artifact so_far) (do (try.with monad) - [content (..write-artifact monad file-system static [module artifact]) + [content (..write_artifact monad file_system static [module artifact]) content (\ monad wrap (\ encoding.utf8 decode content))] - (wrap (sequence so-far + (wrap (sequence so_far (:share [directive] {directive - so-far} + so_far} {directive (:assume content)}))))) - so-far + so_far artifacts)) -(def: #export (package header to-code sequence) +(def: #export (package header to_code sequence) (All [! directive] (-> directive (-> directive Text) (-> directive directive directive) (Packager !))) - (function (package monad file-system static archive program) + (function (package monad file_system static archive program) (do {! (try.with monad)} - [cache (!.use (\ file-system directory) [(get@ #static.target static)]) - order (\ monad wrap (dependency.load-order $.key archive))] + [cache (!.use (\ file_system directory) [(get@ #static.target static)]) + order (\ monad wrap (dependency.load_order $.key archive))] (|> order - (list\map (function (_ [module [module-id [descriptor document]]]) - [module-id + (list\map (function (_ [module [module_id [descriptor document]]]) + [module_id (|> descriptor (get@ #descriptor.registry) artifact.artifacts - row.to-list + row.to_list (list\map (|>> (get@ #artifact.id))))])) - (monad.fold ! (..write-module monad file-system static sequence) header) - (\ ! map (|>> to-code (\ encoding.utf8 encode))))))) + (monad.fold ! (..write_module monad file_system static sequence) header) + (\ ! map (|>> to_code (\ encoding.utf8 encode))))))) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index d65093d7c..0bfb00872 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -16,11 +16,8 @@ [macro ["." code] [syntax (#+ syntax:) - ["cs" common - ["csr" reader] - ["csw" writer] - ["|.|" export] - ["|.|" annotations]]]]]) + ["|.|" export] + ["|.|" annotations]]]]) (type: Stack List) diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index 8fad9d2a6..ff6d3bb3a 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -15,11 +15,8 @@ [macro ["." code] [syntax (#+ syntax:) - ["cs" common - ["csr" reader] - ["csw" writer] - ["|.|" export] - ["|.|" annotations]]]] + ["|.|" export] + ["|.|" annotations]]] [math [number ["i" int] diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index fabd4b335..8ac11dbb1 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -21,10 +21,9 @@ ["." dictionary (#+ Dictionary)] ["." tree]]] [macro + [syntax (#+ syntax:)] ["." code] - ["." poly (#+ poly:)] - [syntax (#+ syntax:) - ["." common]]] + ["." poly (#+ poly:)]] [math [number ["." nat ("#\." decimal)] diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index 741a1b851..66ea54f50 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -14,9 +14,8 @@ [collection ["." list ("#\." monad monoid)]]] [macro + [syntax (#+ syntax:)] ["." code] - [syntax (#+ syntax:) - ["." common]] ["." poly (#+ poly:)]] [math [number diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 6c1a9202c..2788783cc 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -7,8 +7,6 @@ [control ["." io (#+ IO io)] ["." try (#+ Try)] - [parser - [cli (#+ program:)]] [security ["!" capability]] [concurrency diff --git a/stdlib/source/spec/lux/abstract/enum.lux b/stdlib/source/spec/lux/abstract/enum.lux index e598179ad..6d28dead8 100644 --- a/stdlib/source/spec/lux/abstract/enum.lux +++ b/stdlib/source/spec/lux/abstract/enum.lux @@ -8,19 +8,19 @@ {1 ["." /]}) -(def: #export (spec (^open "@//.") gen-sample) +(def: #export (spec (^open "\.") gen-sample) (All [a] (-> (/.Enum a) (Random a) Test)) (do random.monad [sample gen-sample] (<| (_.for [/.Enum]) ($_ _.and (_.test "Successor and predecessor are inverse functions." - (and (@//= (|> sample @//succ @//pred) - sample) - (@//= (|> sample @//pred @//succ) - sample) - (not (@//= (@//succ sample) - sample)) - (not (@//= (@//pred sample) - sample)))) + (and (\= (|> sample \succ \pred) + sample) + (\= (|> sample \pred \succ) + sample) + (not (\= (\succ sample) + sample)) + (not (\= (\pred sample) + sample)))) )))) diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 959b857dd..60619f78b 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -22,7 +22,8 @@ ["#." type] ["#." extension] ["#." time_stamp #_ - ["#/." date]]] + ["#/." date] + ["#/." time]]] {#program ["." /]}) @@ -45,4 +46,5 @@ /type.test /extension.test /time_stamp/date.test + /time_stamp/time.test )))) diff --git a/stdlib/source/test/aedifex/artifact/time_stamp/time.lux b/stdlib/source/test/aedifex/artifact/time_stamp/time.lux new file mode 100644 index 000000000..bd9bbe071 --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/time_stamp/time.lux @@ -0,0 +1,31 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + ["." time (#+ Time)] + [abstract + [monad (#+ do)]] + [control + ["." try ("#\." functor)] + [parser + ["<.>" text]]] + [math + ["." random (#+ Random)] + [number + ["n" nat] + ["i" int]]]] + {#program + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + (do random.monad + [expected random.time] + (_.cover [/.format /.parser] + (|> expected + /.format + (<text>.run /.parser) + (try\map (\ time.equivalence = expected)) + (try.default false)))) + ))) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 35476eee0..54370efb9 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -5,8 +5,7 @@ ["#." code] ["#." template] ["#." poly] - ["#." syntax - ["#/." common]]]) + ["#." syntax]]) (def: #export test Test @@ -14,6 +13,5 @@ /code.test /template.test /syntax.test - /syntax/common.test /poly.test )) diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index 98b955af8..f69af1397 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -49,7 +49,7 @@ [time ["_." instant] ## ["_." duration] - ["_." date]]]]) + ]]]) (type: Variant (#Bit Bit) @@ -103,7 +103,7 @@ ..gen_recursive ## _instant.instant ## _duration.duration - _date.date + random.date ..qty ))) diff --git a/stdlib/source/test/lux/macro/syntax/common/annotations.lux b/stdlib/source/test/lux/macro/syntax/annotations.lux index b1369ef48..564af4ea1 100644 --- a/stdlib/source/test/lux/macro/syntax/common/annotations.lux +++ b/stdlib/source/test/lux/macro/syntax/annotations.lux @@ -19,7 +19,7 @@ ["n" nat]]]] {1 ["." /]} - ["$." //// #_ + ["$." /// #_ ["#." code]]) (def: #export random @@ -28,7 +28,7 @@ tag (random.and word word)] (do {! random.monad} [size (\ ! map (n.% 10) random.nat)] - (random.list size (random.and tag $////code.random))))) + (random.list size (random.and tag $///code.random))))) (def: #export test Test diff --git a/stdlib/source/test/lux/macro/syntax/common/check.lux b/stdlib/source/test/lux/macro/syntax/check.lux index 6b4a4ab3d..898ad8abb 100644 --- a/stdlib/source/test/lux/macro/syntax/common/check.lux +++ b/stdlib/source/test/lux/macro/syntax/check.lux @@ -16,14 +16,14 @@ ["." code ("#\." equivalence)]]] {1 ["." /]} - ["$." //// #_ + ["$." /// #_ ["#." code]]) (def: #export random (Random /.Check) ($_ random.and - $////code.random - $////code.random + $///code.random + $///code.random )) (def: #export test diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux deleted file mode 100644 index 2929417e3..000000000 --- a/stdlib/source/test/lux/macro/syntax/common.lux +++ /dev/null @@ -1,71 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)] - [equivalence (#+ Equivalence)]] - [control - [pipe (#+ case>)] - ["." try] - ["<>" parser - ["<c>" code]]] - [data - ["." product] - ["." bit ("#\." equivalence)] - ["." name] - ["." text] - [collection - ["." list]]] - [macro - ["." code]] - [math - ["." random (#+ Random)] - [number - ["n" nat]]]] - {1 - ["." / - ["#." reader] - ["#." writer]]} - ["." /// #_ - ["#." code]] - ["." / #_ - ["#." annotations] - ["#." check] - ["#." declaration] - ["#." definition] - ["#." export] - ["#." type #_ - ["#/." variable]]]) - -(def: random_text - (Random Text) - (random.ascii/alpha 10)) - -(def: #export test - Test - (<| (_.covering /._) - (_.covering /reader._) - (_.covering /writer._) - ($_ _.and - (do {! random.monad} - [expected (: (Random /.Typed_Input) - (random.and ///code.random - ///code.random))] - (_.cover [/.Typed_Input /reader.typed_input /writer.typed_input] - (|> expected - /writer.typed_input list - (<c>.run /reader.typed_input) - (case> (#try.Success actual) - (let [equivalence (product.equivalence code.equivalence code.equivalence)] - (\ equivalence = expected actual)) - - (#try.Failure error) - false)))) - - /annotations.test - /check.test - /declaration.test - /definition.test - /export.test - /type/variable.test - ))) diff --git a/stdlib/source/test/lux/macro/syntax/common/declaration.lux b/stdlib/source/test/lux/macro/syntax/declaration.lux index a9bc23296..a9bc23296 100644 --- a/stdlib/source/test/lux/macro/syntax/common/declaration.lux +++ b/stdlib/source/test/lux/macro/syntax/declaration.lux diff --git a/stdlib/source/test/lux/macro/syntax/common/definition.lux b/stdlib/source/test/lux/macro/syntax/definition.lux index a769df641..d6b101894 100644 --- a/stdlib/source/test/lux/macro/syntax/common/definition.lux +++ b/stdlib/source/test/lux/macro/syntax/definition.lux @@ -22,7 +22,7 @@ ["$."// #_ ["#." check] ["#." annotations] - ["#//" /// #_ + ["#/" // #_ ["#." code]]]) (def: #export random @@ -30,7 +30,7 @@ ($_ random.and (random.ascii/alpha 5) (random.or $//check.random - $////code.random) + $///code.random) $//annotations.random random.bit )) @@ -64,8 +64,8 @@ (do random.monad [expected ..random - type $////code.random - untyped_value $////code.random] + type $///code.random + untyped_value $///code.random] ($_ _.and (_.cover [/.write /.parser] (case (<code>.run (/.parser compiler) diff --git a/stdlib/source/test/lux/macro/syntax/common/export.lux b/stdlib/source/test/lux/macro/syntax/export.lux index 59b72eb0f..59b72eb0f 100644 --- a/stdlib/source/test/lux/macro/syntax/common/export.lux +++ b/stdlib/source/test/lux/macro/syntax/export.lux diff --git a/stdlib/source/test/lux/macro/syntax/input.lux b/stdlib/source/test/lux/macro/syntax/input.lux new file mode 100644 index 000000000..b0b642645 --- /dev/null +++ b/stdlib/source/test/lux/macro/syntax/input.lux @@ -0,0 +1,46 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try] + [parser + ["<.>" code]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] + {1 + ["." /]} + ["$." /// #_ + ["#." code]]) + +(def: #export random + (Random /.Input) + ($_ random.and + $///code.random + $///code.random + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Input]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (case (<code>.run /.parser + (list (/.format expected))) + (#try.Failure _) + false + + (#try.Success actual) + (\ /.equivalence = expected actual))))))) diff --git a/stdlib/source/test/lux/macro/syntax/common/type/variable.lux b/stdlib/source/test/lux/macro/syntax/type/variable.lux index 4701f5aef..4701f5aef 100644 --- a/stdlib/source/test/lux/macro/syntax/common/type/variable.lux +++ b/stdlib/source/test/lux/macro/syntax/type/variable.lux diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index 5733f40ad..53d7d114e 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -13,6 +13,12 @@ {1 ["." /]}) +(/.with [(!pow/2 <scalar>) + (nat.* <scalar> <scalar>)] + (def: pow/2 + (-> Nat Nat) + (|>> !pow/2))) + (def: #export test Test (<| (_.covering /._) @@ -59,5 +65,37 @@ var1 right] (and (nat.= left var0) (nat.= right var1))))) + (do ! + [scalar random.nat] + (_.cover [/.with] + (let [can_use_with_statements! + (nat.= ($_ nat.* scalar scalar) + (..pow/2 scalar))] + (and can_use_with_statements! + (/.with [(pow/3 <scalar>) + ($_ nat.* <scalar> <scalar> <scalar>) + + (pow/9 <scalar>) + (pow/3 (pow/3 <scalar>))] + (let [can_use_with_expressions! + (nat.= ($_ nat.* scalar scalar scalar) + (pow/3 scalar)) + + can_refer! + (nat.= ($_ nat.* + scalar scalar scalar + scalar scalar scalar + scalar scalar scalar) + (pow/9 scalar)) + + can_shadow! + (let [pow/3 (function (_ scalar) + ($_ nat.+ scalar scalar scalar))] + (nat.= ($_ nat.+ scalar scalar scalar) + (pow/3 scalar)))] + (and can_use_with_expressions! + can_refer! + can_shadow!))) + )))) ))) )) diff --git a/stdlib/source/test/lux/time/date.lux b/stdlib/source/test/lux/time/date.lux index 7ad0e8ddc..1c569e476 100644 --- a/stdlib/source/test/lux/time/date.lux +++ b/stdlib/source/test/lux/time/date.lux @@ -1,35 +1,91 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] - [math - ["." random (#+ Random)]] [abstract - ["." monad (#+ do)] + [monad (#+ do)] {[0 #spec] [/ ["$." equivalence] ["$." order] + ["$." enum] ["$." codec]]}] [control - ["." try]]] - [// - ["_." instant]] + ["." try ("#\." functor)] + ["." exception] + [parser + ["<.>" text]]] + [data + [text + ["%" format (#+ format)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 - ["." / (#+ Date) - ["." // #_ - ["#." instant]]]}) - -(def: #export date - (Random Date) - (\ random.monad map //instant.date - _instant.instant)) + ["." /]}) (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) + (_.for [/.Date]) ($_ _.and - ($equivalence.spec /.equivalence ..date) - ($order.spec /.order ..date) - ($codec.spec /.equivalence /.codec ..date) + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.date)) + (_.for [/.order] + ($order.spec /.order random.date)) + (_.for [/.enum] + ($enum.spec /.enum random.date)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.date)) + + (do random.monad + [expected random.date] + (_.cover [/.date /.year /.month /.day_of_month] + (|> (/.date (/.year expected) + (/.month expected) + (/.day_of_month expected)) + (try\map (\ /.equivalence = expected)) + (try.default false)))) + (do random.monad + [expected random.date] + (_.cover [/.invalid_day] + (case (/.date (/.year expected) + (/.month expected) + (n.+ 31 (/.day_of_month expected))) + (#try.Failure error) + (exception.match? /.invalid_day error) + + (#try.Success _) + false))) + (do random.monad + [expected random.date] + (_.cover [/.to_days /.from_days] + (|> expected + /.to_days + /.from_days + (\ /.equivalence = expected)))) + (do random.monad + [expected random.date] + (_.cover [/.parser] + (|> (\ /.codec encode expected) + (<text>.run /.parser) + (try\map (\ /.equivalence = expected)) + (try.default false)))) + (do {! random.monad} + [year (\ ! map (|>> (n.% 10,000) inc) + random.nat) + month (\ ! map (|>> (n.% 10) (n.+ 13)) + random.nat) + day (\ ! map (|>> (n.% 10) (n.+ 10)) + random.nat) + #let [input (format (%.nat year) + "-" (%.nat month) + "-" (%.nat day))]] + (_.cover [/.invalid_month] + (case (<text>.run /.parser input) + (#try.Failure error) + (exception.match? /.invalid_month error) + + (#try.Success _) + false))) ))) |