aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/number/frac.lux10
-rw-r--r--stdlib/source/lux/data/number/i64.lux35
-rw-r--r--stdlib/source/lux/data/number/rev.lux190
-rw-r--r--stdlib/source/lux/data/text/format.lux33
-rw-r--r--stdlib/source/program/aedifex.lux12
-rw-r--r--stdlib/source/program/aedifex/command/auto.lux13
-rw-r--r--stdlib/source/program/aedifex/command/build.lux71
-rw-r--r--stdlib/source/program/aedifex/command/test.lux45
-rw-r--r--stdlib/source/program/licentia/input.lux171
-rw-r--r--stdlib/source/program/licentia/license/commercial.lux12
-rw-r--r--stdlib/source/test/aedifex/command/auto.lux17
-rw-r--r--stdlib/source/test/aedifex/command/build.lux32
-rw-r--r--stdlib/source/test/aedifex/command/test.lux13
-rw-r--r--stdlib/source/test/lux/data/number/frac.lux2
-rw-r--r--stdlib/source/test/lux/data/number/i64.lux11
-rw-r--r--stdlib/source/test/lux/data/number/rev.lux157
16 files changed, 488 insertions, 336 deletions
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 <identity>)
- (def: compose <compose>)
- )]
+ (def: compose <compose>))]
[disjunction ..false ..or]
[conjunction ..true ..and]
)
+(template [<swap> <size> <pattern>]
+ [(def: <swap>
+ (All [a] (-> (I64 a) (I64 a)))
+ (let [high (try.assume (\ n.binary decode <pattern>))
+ low (..rotate-right <size> high)]
+ (function (_ value)
+ (..or (..logic-right-shift <size> (..and high value))
+ (..left-shift <size> (..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 [<power> <name>]
+ [(def: #export <name>
+ Rev
+ (.rev (//i64.left-shift (//nat.- <power> //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 [<name> <test> <doc>]
@@ -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 [<least-significant-bit> 1]
+ (def: #export (reciprocal numerator)
+ {#.doc "Rev(olution) reciprocal of a Nat(ural)."}
+ (-> Nat Rev)
+ (.rev (case (: Nat ("lux i64 and" <least-significant-bit> 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" <least-significant-bit> param))
+ 0 (..even-reciprocal (.nat param))
+ _ (..odd-reciprocal (.nat param)))]
+ (.rev (//nat.* reciprocal (.nat subject)))))))
+
+(template [<operator> <name> <output> <output-type> <documentation>]
+ [(def: #export (<name> param subject)
+ {#.doc <documentation>}
+ (-> Rev Rev <output-type>)
+ (<output> (<operator> (.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 [<operator> <name>]
+ [(def: #export (<name> scale subject)
+ (-> Nat Rev Rev)
+ (.rev (<operator> (.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 (\ <codec> encode (:coerce Nat value))
- max-num-chars (//nat.+ (//nat./ <char-bit-size> 64)
- (case (//nat.% <char-bit-size> 64)
+ (let [raw-output (\ <codec> encode (.nat value))
+ max-num-chars (//nat.+ (//nat./ <char-bit-size> //i64.width)
+ (case (//nat.% <char-bit-size> //i64.width)
0 0
_ 1))
raw-size ("lux text size" raw-output)
@@ -240,7 +259,7 @@
(^ (char "."))
(case (\ <codec> decode (de-prefix repr))
(#try.Success output)
- (#try.Success (:coerce Rev output))
+ (#try.Success (.rev output))
_
<error-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 [<power> <name>]
- [(def: #export <name>
- Rev
- (.rev (//i64.left-shift (//nat.- <power> 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 [<type> <format>,<codec>]
+ [(`` (template [<format> <codec>]
+ [(def: #export <format>
+ (Format <type>)
+ (\ <codec> encode))]
+
+ (~~ (template.splice <format>,<codec>))))]
+
+ [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 [<call> ((command console environment fs shell resolution) profile)]
+ (with-expansions [<call> ((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))))
+ (<json>.object
+ ($_ <>.and
+ (<json>.field "name" <json>.string)
+ (<json>.field "version" <json>.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 <json>.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)
+ (<json>.object
+ (do <>.monad
+ [start (<json>.field "start" ..amount)
+ end (<json>.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))))
+ (<json>.object
+ ($_ <>.and
+ (<json>.field "name" <json>.string)
+ (<json>.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))))
+ (<json>.object
+ ($_ <>.and
+ (<json>.field "patent retaliation?" <json>.boolean)
+ (<json>.field "termination period" ..amount)
+ (<json>.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))))
+ (<json>.object
+ ($_ <>.and
+ (<json>.field "can accept?" <json>.boolean)
+ (<json>.field "disclaim high risk?" <json>.boolean))))
(def: distribution
(Parser Distribution)
- (json.object
- ($_ parser.and
- (json.field "can re-license?" json.boolean)
- (json.field "can multi-license?" json.boolean))))
+ (<json>.object
+ ($_ <>.and
+ (<json>.field "can re-license?" <json>.boolean)
+ (<json>.field "can multi-license?" <json>.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))))
+ (<json>.object
+ ($_ <>.and
+ (<json>.field "can sell?" <json>.boolean)
+ (<json>.field "require contributor credit?" <json>.boolean)
+ (<json>.field "allow contributor endorsement?" <json>.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))))
+ (<json>.object
+ ($_ <>.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))))
(def: entity
(Parser Entity)
- json.string)
+ <json>.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))))))
+ (<json>.object
+ ($_ <>.and
+ (<json>.field "justification" (<json>.nullable <json>.string))
+ (<json>.field "entities" (<json>.array (<>.many ..entity))))))
(def: url
(Parser URL)
- json.string)
+ <json>.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)))))
+ (<json>.object
+ ($_ <>.and
+ (<json>.field "copyright-notice" <json>.string)
+ (<json>.field "phrase" (<json>.nullable <json>.string))
+ (<json>.field "url" ..url)
+ (<json>.field "image" (<json>.nullable ..url)))))
+
+(def: addendum
+ (Parser Addendum)
+ (<json>.object
+ ($_ <>.and
+ (<json>.field "commons clause?" <json>.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)))))
+ (<json>.object
+ ($_ <>.and
+ (<json>.field "copyright-holders" (<json>.array (<>.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 (<>.some ..black-list)))
+ (<json>.field "attribution" (<json>.nullable ..attribution))
+ (<>.default {#//.commons-clause? false}
+ (<json>.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 [<monoid>]
- [(<| (_.context (%.name (name-of <monoid>)))
- ($monoid.spec /.equivalence <monoid> 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 [<compose> <monoid>]
+ [(_.for [<monoid> <compose>]
+ ($monoid.spec /.equivalence <monoid> random.rev))]
- [/.addition] [/.minimum] [/.maximum]
- ))
- (~~ (template [<codec>]
- [(<| (_.context (%.name (name-of /.binary)))
- ($codec.spec /.equivalence <codec> 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 [<codec>]
+ [(_.for [<codec>]
+ ($codec.spec /.equivalence <codec> random.rev))]
+
+ [/.binary] [/.octal] [/.decimal] [/.hex]
+ ))
+ )))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [.Rev])
+ (`` ($_ _.and
(~~ (template [<half> <whole>]
[(_.cover [<half>]
(/.= <whole>
@@ -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
))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 15:17:40 +0000