From d747aada2d6df6538d0a88d70169f3757aef50af Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 10 Dec 2020 07:28:48 -0400 Subject: Updated Lux license to v0.1.1. --- stdlib/source/lux/data/number/frac.lux | 10 +- stdlib/source/lux/data/number/i64.lux | 35 +++- stdlib/source/lux/data/number/rev.lux | 190 ++++++++++----------- stdlib/source/lux/data/text/format.lux | 33 +++- stdlib/source/program/aedifex.lux | 12 +- stdlib/source/program/aedifex/command/auto.lux | 13 +- stdlib/source/program/aedifex/command/build.lux | 71 ++++---- stdlib/source/program/aedifex/command/test.lux | 45 ++--- stdlib/source/program/licentia/input.lux | 171 ++++++++++--------- .../source/program/licentia/license/commercial.lux | 12 +- stdlib/source/test/aedifex/command/auto.lux | 17 +- stdlib/source/test/aedifex/command/build.lux | 32 +--- stdlib/source/test/aedifex/command/test.lux | 13 +- stdlib/source/test/lux/data/number/frac.lux | 2 +- stdlib/source/test/lux/data/number/i64.lux | 11 +- stdlib/source/test/lux/data/number/rev.lux | 157 +++++++++++++---- 16 files changed, 488 insertions(+), 336 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux index 858fa2980..e4f26154c 100644 --- a/stdlib/source/lux/data/number/frac.lux +++ b/stdlib/source/lux/data/number/frac.lux @@ -115,9 +115,12 @@ (-> Frac Int) (|>> "lux f64 i64")) +(def: mantissa-size Nat 52) +(def: exponent-size Nat 11) + (def: frac-denominator (|> -1 - ("lux i64 logical-right-shift" 11) + ("lux i64 logical-right-shift" ..exponent-size) "lux i64 f64")) (def: #export rev @@ -126,7 +129,7 @@ (..% +1.0) (..* ..frac-denominator) "lux f64 i64" - ("lux i64 left-shift" 11))) + ("lux i64 left-shift" ..exponent-size))) (structure: #export equivalence (Equivalence Frac) @@ -139,9 +142,6 @@ (def: &equivalence ..equivalence) (def: < ..<)) -(def: mantissa-size Nat 52) -(def: exponent-size Nat 11) - (def: #export smallest Frac (math.pow (//int.frac (//int.- (.int ..mantissa-size) ..min-exponent)) diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/data/number/i64.lux index 8dfec1fc7..ea4b1987f 100644 --- a/stdlib/source/lux/data/number/i64.lux +++ b/stdlib/source/lux/data/number/i64.lux @@ -4,6 +4,8 @@ [equivalence (#+ Equivalence)] [hash (#+ Hash)] [monoid (#+ Monoid)]] + [control + ["." try]] [data [number ["n" nat]]]]) @@ -125,8 +127,8 @@ (structure: #export equivalence (All [a] (Equivalence (I64 a))) - (def: (= parameter subject) - ("lux i64 =" parameter subject))) + (def: (= reference sample) + ("lux i64 =" reference sample))) (structure: #export hash (All [a] (Hash (I64 a))) @@ -140,13 +142,38 @@ (All [a] (Monoid (I64 a))) (def: identity ) - (def: compose ) - )] + (def: compose ))] [disjunction ..false ..or] [conjunction ..true ..and] ) +(template [ ] + [(def: + (All [a] (-> (I64 a) (I64 a))) + (let [high (try.assume (\ n.binary decode )) + low (..rotate-right high)] + (function (_ value) + (..or (..logic-right-shift (..and high value)) + (..left-shift (..and low value))))))] + + [swap/32 32 "1111111111111111111111111111111100000000000000000000000000000000"] + [swap/16 16 "1111111111111111000000000000000011111111111111110000000000000000"] + [swap/08 08 "1111111100000000111111110000000011111111000000001111111100000000"] + [swap/04 04 "1111000011110000111100001111000011110000111100001111000011110000"] + [swap/02 02 "1100110011001100110011001100110011001100110011001100110011001100"] + [swap/01 01 "1010101010101010101010101010101010101010101010101010101010101010"] + ) + +(def: #export reverse + (All [a] (-> (I64 a) (I64 a))) + (|>> ..swap/32 + ..swap/16 + ..swap/08 + ..swap/04 + ..swap/02 + ..swap/01)) + (signature: #export (Sub size) (: (Equivalence (I64 size)) &equivalence) diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux index a52be16a4..cc3dce828 100644 --- a/stdlib/source/lux/data/number/rev.lux +++ b/stdlib/source/lux/data/number/rev.lux @@ -7,10 +7,9 @@ [monoid (#+ Monoid)] [equivalence (#+ Equivalence)] [codec (#+ Codec)] - ["." order (#+ Order)]] + [order (#+ Order)]] [control - ["." function] - ["." try (#+ Try)]] + ["." try]] [data ["." maybe] [collection @@ -20,6 +19,25 @@ ["#." nat] ["#." int]]) +(template [ ] + [(def: #export + Rev + (.rev (//i64.left-shift (//nat.- //i64.width) 1)))] + + [01 /2] + [02 /4] + [03 /8] + [04 /16] + [05 /32] + [06 /64] + [07 /128] + [08 /256] + [09 /512] + [10 /1024] + [11 /2048] + [12 /4096] + ) + (def: #export (= reference sample) {#.doc "Rev(olution) equivalence."} (-> Rev Rev Bit) @@ -28,15 +46,13 @@ (def: #export (< reference sample) {#.doc "Rev(olution) less-than."} (-> Rev Rev Bit) - (//nat.< (:coerce Nat reference) - (:coerce Nat sample))) + (//nat.< (.nat reference) (.nat sample))) (def: #export (<= reference sample) {#.doc "Rev(olution) less-than or equal."} (-> Rev Rev Bit) - (if (//nat.< (:coerce Nat reference) - (:coerce Nat sample)) - #1 + (if (//nat.< (.nat reference) (.nat sample)) + true ("lux i64 =" reference sample))) (def: #export (> reference sample) @@ -48,7 +64,7 @@ {#.doc "Rev(olution) greater-than or equal."} (-> Rev Rev Bit) (if (..< sample reference) - #1 + true ("lux i64 =" reference sample))) (template [ ] @@ -101,80 +117,83 @@ ..high ("lux i64 +" top)))) -(def: least-significant-bit-mask (I64 Any) 1) +(def: even-one (//i64.rotate-right 1 1)) +(def: odd-one (dec 0)) + +(def: (even-reciprocal numerator) + (-> Nat Nat) + (//nat./ (//i64.logic-right-shift 1 numerator) + ..even-one)) + +(def: (odd-reciprocal numerator) + (-> Nat Nat) + (//nat./ numerator ..odd-one)) + +(with-expansions [ 1] + (def: #export (reciprocal numerator) + {#.doc "Rev(olution) reciprocal of a Nat(ural)."} + (-> Nat Rev) + (.rev (case (: Nat ("lux i64 and" numerator)) + 0 (..even-reciprocal numerator) + _ (..odd-reciprocal numerator)))) + + (def: #export (/ param subject) + {#.doc "Rev(olution) division."} + (-> Rev Rev Rev) + (if ("lux i64 =" +0 param) + (error! "Cannot divide Rev by zero!") + (let [reciprocal (case (: Nat ("lux i64 and" param)) + 0 (..even-reciprocal (.nat param)) + _ (..odd-reciprocal (.nat param)))] + (.rev (//nat.* reciprocal (.nat subject))))))) + +(template [ ] + [(def: #export ( param subject) + {#.doc } + (-> Rev Rev ) + ( ( (.nat param) (.nat subject))))] + + [//nat.% % .rev Rev "Rev(olution) remainder."] + [//nat./ ratio |> Nat "Ratio between two rev(olution)s."] + ) -(def: (without-trailing-zeroes count remaining) - (-> Nat Nat [Nat Nat]) - (if (|> remaining - ("lux i64 and" least-significant-bit-mask) - ("lux i64 =" 0)) - (without-trailing-zeroes - ("lux i64 +" 1 count) - ("lux i64 logical-right-shift" 1 remaining)) - [count remaining])) +(template [ ] + [(def: #export ( scale subject) + (-> Nat Rev Rev) + (.rev ( (.nat scale) (.nat subject))))] -(def: #export (/ param subject) - {#.doc "Rev(olution) division."} - (-> Rev Rev Rev) - (if ("lux i64 =" +0 param) - (error! "Cannot divide Rev by zero!") - (let [[trailing-zeroes remaining] (without-trailing-zeroes 0 (:coerce Nat param)) - [trailing-zeroes denominator] (: [Nat Nat] - (if ("lux i64 =" +0 trailing-zeroes) - [1 ("lux i64 logical-right-shift" 1 remaining)] - [trailing-zeroes remaining])) - shift ("lux i64 -" trailing-zeroes 64) - numerator ("lux i64 left-shift" shift 1)] - (|> (:coerce Int numerator) - ("lux i64 /" (:coerce Int denominator)) - ("lux i64 *" (:coerce Int subject)) - (:coerce Rev))))) - -(def: #export (% param subject) - {#.doc "Rev(olution) remainder."} - (-> Rev Rev Rev) - (|> (:coerce Nat subject) - (//nat.% (:coerce Nat param)) - (:coerce Rev))) - -(def: #export (scale param subject) - {#.doc "Rev(olution) scale."} - (-> Nat Rev Rev) - (|> (:coerce Int subject) - ("lux i64 *" (:coerce Int param)) - (:coerce Rev))) - -(def: #export (reciprocal numerator) - {#.doc "Rev(olution) reciprocal of a Nat(ural)."} - (-> Nat Rev) - (:coerce Rev - (let [[trailing-zeroes remaining] (without-trailing-zeroes 0 numerator)] - (//nat./ remaining - ({0 (:coerce Nat -1) - _ ("lux i64 left-shift" (//nat.- trailing-zeroes 64) 1)} - trailing-zeroes))))) + [//nat.* up] + [//nat./ down] + ) (def: #export (/% param subject) (-> Rev Rev [Rev Rev]) [(../ param subject) (..% param subject)]) -(def: to-significand +(def: mantissa (-> (I64 Any) Frac) (|>> ("lux i64 logical-right-shift" 11) "lux i64 f64")) -(def: frac-denominator (to-significand -1)) +(def: frac-denominator + (..mantissa -1)) (def: #export frac (-> Rev Frac) - (|>> to-significand ("lux f64 /" frac-denominator))) + (|>> ..mantissa ("lux f64 /" ..frac-denominator))) (structure: #export equivalence (Equivalence Rev) (def: = ..=)) +(structure: #export hash + (Hash Rev) + + (def: &equivalence ..equivalence) + (def: hash .nat)) + (structure: #export order (Order Rev) @@ -217,9 +236,9 @@ (Codec Text Rev) (def: (encode value) - (let [raw-output (\ encode (:coerce Nat value)) - max-num-chars (//nat.+ (//nat./ 64) - (case (//nat.% 64) + (let [raw-output (\ encode (.nat value)) + max-num-chars (//nat.+ (//nat./ //i64.width) + (case (//nat.% //i64.width) 0 0 _ 1)) raw-size ("lux text size" raw-output) @@ -240,7 +259,7 @@ (^ (char ".")) (case (\ decode (de-prefix repr)) (#try.Success output) - (#try.Success (:coerce Rev output)) + (#try.Success (.rev output)) _ ) @@ -309,15 +328,15 @@ (def: (digits::format digits) (-> Digits Text) (loop [idx (dec //i64.width) - all-zeroes? #1 + all-zeroes? true output ""] (if (//int.>= +0 (.int idx)) (let [digit (digits::get idx digits)] (if (and (//nat.= 0 digit) all-zeroes?) - (recur (dec idx) #1 output) + (recur (dec idx) true output) (recur (dec idx) - #0 + false ("lux text concat" (\ //nat.decimal encode digit) output)))) @@ -392,7 +411,7 @@ (Codec Text Rev) (def: (encode input) - (case (:coerce Nat input) + (case (.nat input) 0 ".0" @@ -414,10 +433,10 @@ (def: (decode input) (let [dotted? (case ("lux text index" 0 "." input) (#.Some 0) - #1 + true _ - #0) + false) within-limits? (//nat.<= (inc //i64.width) ("lux text size" input))] (if (and dotted? within-limits?) @@ -434,34 +453,9 @@ (recur (digits::-! power digits) (inc idx) (//i64.set (//nat.- idx (dec //i64.width)) output)))) - (#try.Success (:coerce Rev output)))) + (#try.Success (.rev output)))) #.None (#try.Failure ("lux text concat" "Wrong syntax for Rev: " input))) (#try.Failure ("lux text concat" "Wrong syntax for Rev: " input)))) )) - -(structure: #export hash - (Hash Rev) - - (def: &equivalence ..equivalence) - (def: hash .nat)) - -(template [ ] - [(def: #export - Rev - (.rev (//i64.left-shift (//nat.- 64) 1)))] - - [01 /2] - [02 /4] - [03 /8] - [04 /16] - [05 /32] - [06 /64] - [07 /128] - [08 /256] - [09 /512] - [10 /1024] - [11 /2048] - [12 /4096] - ) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 5d6bdf07f..e805f7cfc 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -30,7 +30,8 @@ ["." modular]] [macro [syntax (#+ syntax:)] - ["." code]] + ["." code] + ["." template]] [meta ["." location]] ["." type]]) @@ -76,6 +77,36 @@ [location Location location.format] ) +(template [ ,] + [(`` (template [ ] + [(def: #export + (Format ) + (\ encode))] + + (~~ (template.splice ,))))] + + [Nat + [[nat/2 nat.binary] + [nat/8 nat.octal] + [nat/10 nat.decimal] + [nat/16 nat.hex]]] + [Int + [[int/2 int.binary] + [int/8 int.octal] + [int/10 int.decimal] + [int/16 int.hex]]] + [Rev + [[rev/2 rev.binary] + [rev/8 rev.octal] + [rev/10 rev.decimal] + [rev/16 rev.hex]]] + [Frac + [[frac/2 frac.binary] + [frac/8 frac.octal] + [frac/10 frac.decimal] + [frac/16 frac.hex]]] + ) + (def: #export (mod modular) (All [m] (Format (modular.Mod m))) (let [[_ modulus] (modular.un-mod modular)] diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 160720fa7..aac616597 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -33,7 +33,7 @@ [world ["." shell (#+ Shell)] ["." console (#+ Console)] - ["." program] + ["." program (#+ Program)] ["." file (#+ Path) ["." watch]]]] ["." / #_ @@ -68,13 +68,11 @@ (def: (with-dependencies console command profile) (All [a] (-> (Console Promise) - (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command a)) + (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command a)) (Command a))) - (do promise.monad - [environment (promise.future (\ program.default environment []))] - (do /action.monad - [resolution (/command/deps.do! console (file.async file.default) (..repositories profile) profile)] - ((command console environment (file.async file.default) (shell.async shell.default) resolution) profile)))) + (do /action.monad + [resolution (/command/deps.do! console (file.async file.default) (..repositories profile) profile)] + ((command console (program.async program.default) (file.async file.default) (shell.async shell.default) resolution) profile))) (exception: (cannot-find-repository {repository Text} {options (Dictionary Text Address)}) diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index a2f2b1ff5..4b151861b 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -7,14 +7,13 @@ [concurrency ["." promise (#+ Promise)]] [security - ["!" capability]] - [parser - [environment (#+ Environment)]]] + ["!" capability]]] [data [collection ["." list] ["." set]]] [world + [program (#+ Program)] [shell (#+ Shell)] ["." console (#+ Console)] ["." file (#+ Path) @@ -50,11 +49,11 @@ (def: #export (do! watcher command) (All [a] (-> (Watcher Promise) - (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command a)) - (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command Any)))) - (function (_ console environment fs shell resolution) + (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command a)) + (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command Any)))) + (function (_ console program fs shell resolution) (function (_ profile) - (with-expansions [ ((command console environment fs shell resolution) profile)] + (with-expansions [ ((command console program fs shell resolution) profile)] (do {! promise.monad} [targets (|> profile (get@ #///.sources) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 78e38a6c5..8960d9c75 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -9,9 +9,7 @@ [concurrency ["." promise (#+ Promise) ("#\." monad)]] [security - ["!" capability]] - [parser - [environment (#+ Environment)]]] + ["!" capability]]] [data ["." product] ["." maybe] @@ -24,6 +22,7 @@ [number ["i" int]]] [world + [program (#+ Program)] ["." file (#+ Path)] ["." shell (#+ Shell)] ["." console (#+ Console)]]] @@ -108,10 +107,6 @@ (list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux-library))) (list\map (|>> (get@ #///dependency.artifact) (///local.path fs))))) -(def: #export working-directory - (-> Environment (Try Text)) - (|>> (dictionary.get "user.dir") try.from-maybe)) - (def: (singular name) (-> Text Text (List Text)) (|>> (list name))) @@ -124,8 +119,8 @@ (def: #export success "[BUILD ENDED]") (def: #export failure "[BUILD FAILED]") -(def: #export (do! console environment fs shell resolution profile) - (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command [Compiler Path])) +(def: #export (do! console program fs shell resolution profile) + (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command [Compiler Path])) (case [(get@ #///.program profile) (get@ #///.target profile)] [#.None _] @@ -134,31 +129,33 @@ [_ #.None] (promise\wrap (exception.throw ..no-specified-target [])) - [(#.Some program) (#.Some target)] - (do ///action.monad - [[resolution compiler] (promise\wrap (..compiler resolution)) - working-directory (promise\wrap (..working-directory environment)) - #let [[command output] (let [[compiler output] (case compiler - (#JVM artifact) [(///runtime.java (///local.path fs artifact)) - "program.jar"] - (#JS artifact) [(///runtime.node (///local.path fs artifact)) - "program.js"])] - [(format compiler " build") output]) - / (\ fs separator) - cache-directory (format working-directory / target)] - _ (console.write-line ..start console) - process (!.use (\ shell execute) - [environment - working-directory - command - (list.concat (list (..plural "--library" (..libraries fs resolution)) - (..plural "--source" (set.to-list (get@ #///.sources profile))) - (..singular "--target" cache-directory) - (..singular "--module" program)))]) - exit (!.use (\ process await) []) - _ (console.write-line (if (i.= shell.normal exit) - ..success - ..failure) - console)] - (wrap [compiler - (format cache-directory / output)])))) + [(#.Some program-module) (#.Some target)] + (do promise.monad + [environment (\ program environment []) + working-directory (\ program directory [])] + (do ///action.monad + [[resolution compiler] (promise\wrap (..compiler resolution)) + #let [[command output] (let [[compiler output] (case compiler + (#JVM artifact) [(///runtime.java (///local.path fs artifact)) + "program.jar"] + (#JS artifact) [(///runtime.node (///local.path fs artifact)) + "program.js"])] + [(format compiler " build") output]) + / (\ fs separator) + cache-directory (format working-directory / target)] + _ (console.write-line ..start console) + process (!.use (\ shell execute) + [environment + working-directory + command + (list.concat (list (..plural "--library" (..libraries fs resolution)) + (..plural "--source" (set.to-list (get@ #///.sources profile))) + (..singular "--target" cache-directory) + (..singular "--module" program-module)))]) + exit (!.use (\ process await) []) + _ (console.write-line (if (i.= shell.normal exit) + ..success + ..failure) + console)] + (wrap [compiler + (format cache-directory / output)]))))) diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index 3b5afaabf..089417b94 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -6,15 +6,14 @@ [concurrency ["." promise (#+ Promise) ("#\." monad)]] [security - ["!" capability]] - [parser - [environment (#+ Environment)]]] + ["!" capability]]] [data [text ["%" format (#+ format)]] [number ["i" int]]] [world + [program (#+ Program)] ["." file] ["." shell (#+ Shell)] ["." console (#+ Console)]]] @@ -31,22 +30,24 @@ (def: #export success "[TEST ENDED]") (def: #export failure "[TEST FAILED]") -(def: #export (do! console environment fs shell resolution profile) - (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command Any)) - (do ///action.monad - [[compiler program] (//build.do! console environment fs shell resolution profile) - working-directory (promise\wrap (//build.working-directory environment)) - _ (console.write-line ..start console) - process (!.use (\ shell execute) - [environment - working-directory - (case compiler - (#//build.JVM artifact) (///runtime.java program) - (#//build.JS artifact) (///runtime.node program)) - (list)]) - exit (!.use (\ process await) []) - _ (console.write-line (if (i.= shell.normal exit) - ..success - ..failure) - console)] - (wrap []))) +(def: #export (do! console program fs shell resolution profile) + (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command Any)) + (do promise.monad + [environment (\ program environment []) + working-directory (\ program directory [])] + (do ///action.monad + [[compiler program] (//build.do! console program fs shell resolution profile) + _ (console.write-line ..start console) + process (!.use (\ shell execute) + [environment + working-directory + (case compiler + (#//build.JVM artifact) (///runtime.java program) + (#//build.JS artifact) (///runtime.node program)) + (list)]) + exit (!.use (\ process await) []) + _ (console.write-line (if (i.= shell.normal exit) + ..success + ..failure) + console)] + (wrap [])))) diff --git a/stdlib/source/program/licentia/input.lux b/stdlib/source/program/licentia/input.lux index 48617f045..5ec07e32b 100644 --- a/stdlib/source/program/licentia/input.lux +++ b/stdlib/source/program/licentia/input.lux @@ -4,8 +4,8 @@ [monad (#+ do)]] [control ["." exception (#+ exception:)] - ["." parser - ["." json (#+ Parser)]]] + ["<>" parser + ["<.>" json (#+ Parser)]]] [data [text ["%" format (#+ format)]] @@ -13,25 +13,26 @@ ["n" nat] ["i" int] ["f" frac]]]] - [// - [license (#+ Identification - Termination - Liability - Distribution - Commercial - Extension - Entity Black-List - URL Attribution - License) + ["." // #_ + ["#" license (#+ Identification + Termination + Liability + Distribution + Commercial + Extension + Entity Black-List + URL Attribution + Addendum + License) ["." time (#+ Period)] ["." copyright]]]) (def: identification (Parser Identification) - (json.object - ($_ parser.and - (json.field "name" json.string) - (json.field "version" json.string)))) + (.object + ($_ <>.and + (.field "name" .string) + (.field "version" .string)))) (exception: #export (cannot-use-fractional-amount {amount Frac}) (exception.report @@ -43,14 +44,14 @@ (def: amount (Parser Nat) - (do parser.monad - [amountF json.number + (do <>.monad + [amountF .number #let [amountI (f.int amountF)] - _ (parser.assert (exception.construct cannot-use-fractional-amount amountF) - (f.= amountF - (i.frac amountI))) - _ (parser.assert (exception.construct cannot-use-negative-amount amountI) - (i.> +0 amountI))] + _ (<>.assert (exception.construct cannot-use-fractional-amount amountF) + (f.= amountF + (i.frac amountI))) + _ (<>.assert (exception.construct cannot-use-negative-amount amountI) + (i.> +0 amountI))] (wrap (.nat amountI)))) (exception: #export (invalid-period {period (Period Nat)}) @@ -60,96 +61,106 @@ (def: period (Parser (Period Nat)) - (json.object - (do parser.monad - [start (json.field "start" ..amount) - end (json.field "end" ..amount) + (.object + (do <>.monad + [start (.field "start" ..amount) + end (.field "end" ..amount) #let [period {#time.start start #time.end end}] - _ (parser.assert (exception.construct invalid-period period) - (n.<= end start))] + _ (<>.assert (exception.construct invalid-period period) + (n.<= end start))] (wrap period)))) (def: copyright-holder (Parser copyright.Holder) - (json.object - ($_ parser.and - (json.field "name" json.string) - (json.field "period" ..period)))) + (.object + ($_ <>.and + (.field "name" .string) + (.field "period" ..period)))) (def: termination (Parser Termination) - (json.object - ($_ parser.and - (json.field "patent retaliation?" json.boolean) - (json.field "termination period" ..amount) - (json.field "grace period" ..amount)))) + (.object + ($_ <>.and + (.field "patent retaliation?" .boolean) + (.field "termination period" ..amount) + (.field "grace period" ..amount)))) (def: liability (Parser Liability) - (json.object - ($_ parser.and - (json.field "can accept?" json.boolean) - (json.field "disclaim high risk?" json.boolean)))) + (.object + ($_ <>.and + (.field "can accept?" .boolean) + (.field "disclaim high risk?" .boolean)))) (def: distribution (Parser Distribution) - (json.object - ($_ parser.and - (json.field "can re-license?" json.boolean) - (json.field "can multi-license?" json.boolean)))) + (.object + ($_ <>.and + (.field "can re-license?" .boolean) + (.field "can multi-license?" .boolean)))) (def: commercial (Parser Commercial) - (json.object - ($_ parser.and - (json.field "can sell?" json.boolean) - (json.field "require contributor credit?" json.boolean) - (json.field "allow contributor endorsement?" json.boolean)))) + (.object + ($_ <>.and + (.field "can sell?" .boolean) + (.field "require contributor credit?" .boolean) + (.field "allow contributor endorsement?" .boolean)))) (def: extension (Parser Extension) - (json.object - ($_ parser.and - (json.field "same license?" json.boolean) - (json.field "must be distinguishable?" json.boolean) - (json.field "notification period" (json.nullable ..period)) - (json.field "must describe modifications?" json.boolean)))) + (.object + ($_ <>.and + (.field "same license?" .boolean) + (.field "must be distinguishable?" .boolean) + (.field "notification period" (.nullable ..period)) + (.field "must describe modifications?" .boolean)))) (def: entity (Parser Entity) - json.string) + .string) (def: black-list (Parser Black-List) - (json.object - ($_ parser.and - (json.field "justification" (json.nullable json.string)) - (json.field "entities" (json.array (parser.many ..entity)))))) + (.object + ($_ <>.and + (.field "justification" (.nullable .string)) + (.field "entities" (.array (<>.many ..entity)))))) (def: url (Parser URL) - json.string) + .string) (def: attribution (Parser Attribution) - (json.object - ($_ parser.and - (json.field "copyright-notice" json.string) - (json.field "phrase" (json.nullable json.string)) - (json.field "url" ..url) - (json.field "image" (json.nullable ..url))))) + (.object + ($_ <>.and + (.field "copyright-notice" .string) + (.field "phrase" (.nullable .string)) + (.field "url" ..url) + (.field "image" (.nullable ..url))))) + +(def: addendum + (Parser Addendum) + (.object + ($_ <>.and + (.field "commons clause?" .boolean) + ))) (def: #export license (Parser License) - (json.object - ($_ parser.and - (json.field "copyright-holders" (json.array (parser.many ..copyright-holder))) - (json.field "identification" (json.nullable ..identification)) - (json.field "termination" ..termination) - (json.field "liability" ..liability) - (json.field "distribution" ..distribution) - (json.field "commercial" ..commercial) - (json.field "extension" ..extension) - (json.field "black-lists" (json.array (parser.some ..black-list))) - (json.field "attribution" (json.nullable ..attribution))))) + (.object + ($_ <>.and + (.field "copyright-holders" (.array (<>.many ..copyright-holder))) + (.field "identification" (.nullable ..identification)) + (.field "termination" ..termination) + (.field "liability" ..liability) + (.field "distribution" ..distribution) + (.field "commercial" ..commercial) + (.field "extension" ..extension) + (.field "black-lists" (.array (<>.some ..black-list))) + (.field "attribution" (.nullable ..attribution)) + (<>.default {#//.commons-clause? false} + (.field "addendum" ..addendum)) + ))) diff --git a/stdlib/source/program/licentia/license/commercial.lux b/stdlib/source/program/licentia/license/commercial.lux index 05b8c3966..e044baa43 100644 --- a/stdlib/source/program/licentia/license/commercial.lux +++ b/stdlib/source/program/licentia/license/commercial.lux @@ -10,11 +10,13 @@ (def: #export cannot-sell (let [preamble (format "Without limiting other conditions in " _.license) - condition (format "the grant of rights under " _.license - " will not include, and " _.license - " does not grant to " _.recipient - ", the right to " _.sell " " _.work)] - ($.sentence (format preamble ", " condition)))) + direct-condition (format "the grant of rights under " _.license + " will not include, and does not grant to " _.recipient + ", the right to " _.sell " " _.work) + derivative-condition (format "or any " _.derivative-work)] + ($.sentence (format preamble + ", " direct-condition + ", " derivative-condition)))) (def: #export require-contributor-attribution ($.sentence (format "All advertising materials mentioning features or use of " _.work diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index e8f6d17f1..48b2a7eb3 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -26,6 +26,7 @@ [world [console (#+ Console)] ["." shell (#+ Shell)] + ["." program (#+ Program)] ["." file (#+ Path) ["." watch]]]] ["." // #_ @@ -49,11 +50,11 @@ (def: (command end-signal dummy-files) (-> Text (List Path) [(Atom [Nat (List Path)]) - (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command Any))]) + (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command Any))]) (let [@runs (: (Atom [Nat (List Path)]) (atom.atom [0 dummy-files]))] [@runs - (function (_ console environment fs shell resolution profile) + (function (_ console program fs shell resolution profile) (do {! promise.monad} [[runs remaining-files] (promise.future (atom.update (function (_ [runs remaining-files]) @@ -95,9 +96,7 @@ profile (|> empty-profile with-program with-target - (set@ #///.sources (set.from-list text.hash (list source)))) - - environment (dictionary.put "user.dir" working-directory environment.empty)] + (set@ #///.sources (set.from-list text.hash (list source))))] resolution @build.resolution] ($_ _.and (wrap (do promise.monad @@ -106,7 +105,13 @@ _ (!.use (\ fs create-directory) [source]) _ (\ watcher poll [])] (do promise.monad - [outcome ((/.do! watcher command) (@version.echo "") environment fs (@build.good-shell []) resolution profile) + [outcome ((/.do! watcher command) + (@version.echo "") + (program.async (program.mock environment.empty working-directory)) + fs + (@build.good-shell []) + resolution + profile) [actual-runs _] (promise.future (atom.read @runs))] (wrap (#try.Success (and (n.= expected-runs actual-runs) (case outcome diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 6a911e928..74508ef3d 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -20,7 +20,8 @@ ["." random]] [world ["." file] - ["." shell (#+ Shell)]]] + ["." shell (#+ Shell)] + ["." program]]] ["." // #_ ["@." version] ["$/#" // #_ @@ -110,27 +111,10 @@ profile (|> empty-profile with-program - with-target) - - no-working-directory environment.empty - - environment (dictionary.put "user.dir" working-directory environment.empty)]] + with-target)]] ($_ _.and - (_.cover [/.working-directory] - (and (case (/.working-directory no-working-directory) - (#try.Success _) - false - - (#try.Failure error) - true) - (case (/.working-directory environment) - (#try.Success _) - true - - (#try.Failure error) - false))) (wrap (do promise.monad - [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty working-directory)) fs shell ///dependency/resolution.empty (with-target empty-profile))] (_.cover' [/.no-specified-program] (case outcome @@ -140,7 +124,7 @@ (#try.Failure error) (exception.match? /.no-specified-program error))))) (wrap (do promise.monad - [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty working-directory)) fs shell ///dependency/resolution.empty (with-program empty-profile))] (_.cover' [/.no-specified-target] (case outcome @@ -150,7 +134,7 @@ (#try.Failure error) (exception.match? /.no-specified-target error))))) (wrap (do promise.monad - [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty profile)] + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty working-directory)) fs shell ///dependency/resolution.empty profile)] (_.cover' [/.Compiler /.no-available-compiler] (case outcome (#try.Success _) @@ -163,7 +147,7 @@ resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console environment fs shell resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty working-directory)) fs shell resolution profile) start (!.use (\ console read-line) []) end (!.use (\ console read-line) [])] (wrap (and (text\= /.start start) @@ -177,7 +161,7 @@ resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console environment fs (..bad-shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty working-directory)) fs (..bad-shell []) resolution profile) start (!.use (\ console read-line) []) end (!.use (\ console read-line) [])] (wrap (and (text\= /.start start) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 43c70d8ba..f87e70e85 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -19,7 +19,8 @@ ["." random]] [world ["." file] - ["." shell]]] + ["." shell] + ["." program]]] ["." // #_ ["@." version] ["@." build] @@ -53,18 +54,14 @@ profile (|> empty-profile with-program - with-target) - - no-working-directory environment.empty - - environment (dictionary.put "user.dir" working-directory environment.empty)] + with-target)] resolution @build.resolution] ($_ _.and (let [fs (file.mock (\ file.default separator)) console (@version.echo "")] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console environment fs (@build.good-shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty working-directory)) fs (@build.good-shell []) resolution profile) build-start (!.use (\ console read-line) []) build-end (!.use (\ console read-line) []) test-start (!.use (\ console read-line) []) @@ -98,7 +95,7 @@ shell.normal shell.error)])))))) [])] - _ (/.do! console environment fs bad-shell resolution profile) + _ (/.do! console (program.async (program.mock environment.empty working-directory)) fs bad-shell resolution profile) build-start (!.use (\ console read-line) []) build-end (!.use (\ console read-line) []) test-start (!.use (\ console read-line) []) diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index aa472c572..f29cf93b1 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -84,7 +84,7 @@ (_.cover [/.int] (|> expected i.frac /.int (i.= expected)))) (do {! random.monad} - [expected (\ ! map (|>> (i64.left-shift 32) .rev) + [expected (\ ! map (|>> (i64.left-shift 52) .rev) random.nat)] (_.cover [/.rev] (|> expected r.frac /.rev (r.= expected)))) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 49f63d1a9..12b935bef 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -3,7 +3,7 @@ ["_" test (#+ Test)] [data ["." bit ("#\." equivalence)] - [number + [number (#+ hex) ["n" nat] ["i" int]]] [abstract @@ -261,6 +261,15 @@ inverse! nullity! futility!))) + (_.cover [/.reverse] + (and (|> pattern /.reverse /.reverse (\= pattern)) + (or (|> pattern /.reverse (\= pattern) not) + (let [high (/.and (hex "FFFFFFFF00000000") + pattern) + low (/.and (hex "00000000FFFFFFFF") + pattern)] + (\= (/.reverse high) + low))))) (_.cover [/.hash] (n.= pattern (\ /.hash hash pattern))) diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index 90a29c6d3..c28f89451 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] @@ -13,41 +12,49 @@ ["$." monoid] ["$." codec]]}] [data - [number - ["." i64]]] + ["." bit ("#\." equivalence)] + [number (#+ hex) + ["n" nat] + ["f" frac] + ["." i64 ("#\." hash)]]] [math - ["r" random]]] + ["." random]]] {1 - ["." / - //]}) + ["." /]}) -(def: #export test +(def: signature Test - (<| (_.context (%.name (name-of /._))) - (`` ($_ _.and - ($equivalence.spec /.equivalence r.rev) - ($order.spec /.order r.rev) - ($enum.spec /.enum r.rev) - ($interval.spec /.interval r.rev) - (~~ (template [] - [(<| (_.context (%.name (name-of ))) - ($monoid.spec /.equivalence r.rev))] + (`` ($_ _.and + (_.for [/.equivalence /.=] + ($equivalence.spec /.equivalence random.rev)) + (_.for [/.order /.<] + ($order.spec /.order random.rev)) + (_.for [/.enum] + ($enum.spec /.enum random.rev)) + (_.for [/.interval] + ($interval.spec /.interval random.rev)) + (~~ (template [ ] + [(_.for [ ] + ($monoid.spec /.equivalence random.rev))] - [/.addition] [/.minimum] [/.maximum] - )) - (~~ (template [] - [(<| (_.context (%.name (name-of /.binary))) - ($codec.spec /.equivalence r.rev))] + [/.+ /.addition] - [/.binary] [/.octal] [/.decimal] [/.hex] - )) - (_.test "Alternate notations." - (and (/.= (bin ".11001001") - (bin ".11,00,10,01")) - (/.= (oct ".615243") - (oct ".615,243")) - (/.= (hex ".deadBEEF") - (hex ".dead,BEEF")))) + [/.min /.minimum] + [/.max /.maximum] + )) + (~~ (template [] + [(_.for [] + ($codec.spec /.equivalence random.rev))] + + [/.binary] [/.octal] [/.decimal] [/.hex] + )) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [.Rev]) + (`` ($_ _.and (~~ (template [ ] [(_.cover [] (/.= @@ -66,4 +73,94 @@ [/./2048 /./1024] [/./4096 /./2048] )) + (do random.monad + [sample random.rev] + (_.cover [/.-] + (and (/.= .0 (/.- sample sample)) + (/.= sample (/.- .0 sample))))) + (do {! random.monad} + [left random.rev + right random.rev] + (_.cover [/.*] + (and (/.< left (/.* left right)) + (/.< right (/.* left right))))) + (do {! random.monad} + [#let [dividend (\ ! map (i64.and (hex "FF")) + random.rev) + divisor (\ ! map (|>> (i64.and (hex "F")) + (i64.or (hex "1")) + (i64.rotate-right 8) + .rev) + random.nat)] + dividend dividend + divisor/0 divisor + divisor/1 (random.filter (|>> (/.= divisor/0) not) + divisor) + scale (\ ! map (|>> (n.% 10) inc) + random.nat)] + ($_ _.and + (_.cover [/./] + (bit\= (/.< divisor/0 divisor/1) + (/.> (/./ divisor/0 dividend) (/./ divisor/1 dividend)))) + (_.cover [/.%] + (\ i64.equivalence = + (.i64 (n.% (.nat divisor/0) (.nat dividend))) + (.i64 (/.% divisor/0 dividend)))) + (_.cover [/.up /.down] + (let [symmetry! + (|> dividend + (/.up scale) + (/.down scale) + (/.= dividend)) + + discrete-division! + (/.= (/.% (.rev scale) dividend) + (/.- (|> dividend + (/.down scale) + (/.up scale)) + dividend))] + (and symmetry! + discrete-division!))) + (_.cover [/.ratio] + (|> dividend + (/.up scale) + (/.ratio dividend) + (n.= scale))) + )) + (do {! random.monad} + [dividend random.rev + divisor (random.filter (|>> (/.= .0) not) + random.rev)] + (_.cover [/./%] + (let [[quotient remainder] (/./% divisor dividend)] + (and (/.= (/./ divisor dividend) quotient) + (/.= (/.% divisor dividend) remainder))))) + (do random.monad + [left random.rev + right random.rev] + ($_ _.and + (_.cover [/.>] + (bit\= (/.> left right) + (/.< right left))) + (_.cover [/.<= /.>=] + (bit\= (/.<= left right) + (/.>= right left))) + )) + (do random.monad + [sample random.nat] + (_.cover [/.reciprocal] + (/.= (/.reciprocal sample) + (|> sample /.reciprocal .nat /.reciprocal .nat /.reciprocal)))) + (do {! random.monad} + [expected (\ ! map (|>> f.abs (f.% +1.0)) + random.safe-frac)] + (_.cover [/.frac] + (|> expected f.rev /.frac (f.= expected)))) + (do random.monad + [sample random.rev] + (_.cover [/.hash] + (i64\= (i64\hash sample) + (\ /.hash hash sample)))) + + ..signature )))) -- cgit v1.2.3