aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux13
-rw-r--r--stdlib/source/lux/control/pipe.lux48
-rw-r--r--stdlib/source/lux/data/bit.lux5
-rw-r--r--stdlib/source/lux/data/coll/bits.lux165
-rw-r--r--stdlib/source/lux/math.lux8
-rw-r--r--stdlib/source/lux/math/modular.lux13
6 files changed, 212 insertions, 40 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index e4214a899..51e9af4dc 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -6054,3 +6054,16 @@
_
(fail "Wrong syntax for ^code")))
+
+(def: #export (n/mod param subject)
+ (-> Nat Nat Nat)
+ (let [exact (|> subject (n// param) (n/* param))]
+ (|> subject (n/- exact))))
+
+(def: #export (i/mod param subject)
+ (All [m] (-> Int Int Int))
+ (let [raw (i/% param subject)]
+ (if (i/< 0 raw)
+ (let [shift (if (i/< 0 param) i/- i/+)]
+ (|> raw (shift param)))
+ raw)))
diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux
index a5ba038f5..b70ec8f8a 100644
--- a/stdlib/source/lux/control/pipe.lux
+++ b/stdlib/source/lux/control/pipe.lux
@@ -1,8 +1,9 @@
(.module: {#.doc "Composable extensions to the piping macros (|> and <|) that enhance them with various abilities."}
lux
- (lux (control ["M" monad #+ do Monad]
+ (lux (control [monad #+ do]
["p" parser])
- (data (coll [list #+ Monad<List> "L/" Fold<List> Monad<List>]))
+ (data ["e" error]
+ (coll [list #+ "list/" Fold<List> Monad<List>]))
[macro #+ with-gensyms]
(macro ["s" syntax #+ syntax: Syntax]
[code])
@@ -11,7 +12,7 @@
## [Syntax]
(def: body^
(Syntax (List Code))
- (s.tuple (p.many s.any)))
+ (s.tuple (p.some s.any)))
(syntax: #export (new> [tokens (p.at-least +2 s.any)])
{#.doc (doc "Ignores the piped argument, and begins a new pipe."
@@ -33,12 +34,18 @@
(wrap (list (` (let [(~ binding) (~ prev)]
(~ body))))))
-(syntax: #export (cond> [branches (p.many (p.seq body^ body^))]
- [?else (p.maybe body^)]
- prev)
+(def: _reverse_
+ (Syntax Unit)
+ (function [tokens]
+ (#e.Success [(list.reverse tokens) []])))
+
+(syntax: #export (cond> [_ _reverse_]
+ prev
+ [else body^]
+ [_ _reverse_]
+ [branches (p.many (p.seq body^ body^))])
{#.doc (doc "Branching for pipes."
"Both the tests and the bodies are piped-code, and must be given inside a tuple."
- "If a last else-pipe is not given, the piped-argument will be used instead."
(|> 5
(cond> [i/even?] [(i/* 2)]
[i/odd?] [(i/* 3)]
@@ -46,16 +53,11 @@
(with-gensyms [g!temp]
(wrap (list (` (with-expansions
[(~ g!temp) (~ prev)]
- (cond (~+ (do Monad<List>
+ (cond (~+ (do list.Monad<List>
[[test then] branches]
(list (` (|> (~ g!temp) (~+ test)))
(` (|> (~ g!temp) (~+ then))))))
- (~ (case ?else
- (#.Some else)
- (` (|> (~ g!temp) (~+ else)))
-
- _
- g!temp)))))))))
+ (|> (~ g!temp) (~+ else)))))))))
(syntax: #export (loop> [test body^] [then body^] prev)
{#.doc (doc "Loops for pipes."
@@ -80,13 +82,13 @@
(with-gensyms [g!temp]
(case (list.reverse steps)
(^ (list& last-step prev-steps))
- (let [step-bindings (do Monad<List>
+ (let [step-bindings (do list.Monad<List>
[step (list.reverse prev-steps)]
(list g!temp (` (|> (~ g!temp) (~+ step)))))]
- (wrap (list (` (do (~ monad)
- [(~ g!temp) (~ prev)
- (~+ step-bindings)]
- (|> (~ g!temp) (~+ last-step)))))))
+ (wrap (list (` ((~! do) (~ monad)
+ [(~ g!temp) (~ prev)
+ (~+ step-bindings)]
+ (|> (~ g!temp) (~+ last-step)))))))
_
(wrap (list prev)))))
@@ -112,8 +114,8 @@
"Will become: [50 2 \"5\"]")}
(with-gensyms [g!temp]
(wrap (list (` (let [(~ g!temp) (~ prev)]
- [(~+ (L/map (function [body] (` (|> (~ g!temp) (~+ body))))
- paths))]))))))
+ [(~+ (list/map (function [body] (` (|> (~ g!temp) (~+ body))))
+ paths))]))))))
(syntax: #export (case> [branches (p.many (p.seq s.any s.any))] prev)
{#.doc (doc "Pattern-matching for pipes."
@@ -131,5 +133,5 @@
9 "nine"
_ "???")))}
(wrap (list (` (case (~ prev)
- (~+ (L/join (L/map (function [[pattern body]] (list pattern body))
- branches))))))))
+ (~+ (list/join (list/map (function [[pattern body]] (list pattern body))
+ branches))))))))
diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux
index 4f9474a90..65d1bef84 100644
--- a/stdlib/source/lux/data/bit.lux
+++ b/stdlib/source/lux/data/bit.lux
@@ -59,3 +59,8 @@
[rotate-left shift-left shift-right]
[rotate-right shift-right shift-left]
)
+
+(def: #export (region-mask size offset)
+ (-> Nat Nat Nat)
+ (let [pattern (|> +1 (shift-left size) n/dec)]
+ (shift-left offset pattern)))
diff --git a/stdlib/source/lux/data/coll/bits.lux b/stdlib/source/lux/data/coll/bits.lux
new file mode 100644
index 000000000..e7a407b1c
--- /dev/null
+++ b/stdlib/source/lux/data/coll/bits.lux
@@ -0,0 +1,165 @@
+(.module:
+ [lux #- not and or]
+ (lux (control [eq #+ Eq]
+ pipe)
+ (data [maybe]
+ [bit]
+ (coll [array "array/" Fold<Array>])
+ text/format)))
+
+(type: #export Chunk Nat)
+
+(def: #export chunk-size bit.width)
+
+(type: #export Bits
+ (Array Chunk))
+
+(def: empty-chunk Chunk +0)
+
+(def: (n//% param subject)
+ (-> Nat Nat [Nat Nat])
+ [(n// param subject)
+ (n/% param subject)])
+
+(def: #export empty
+ Bits
+ (array.new +0))
+
+(def: #export (size bits)
+ (-> Bits Nat)
+ (array/fold (function [chunk total]
+ (n/+ total (bit.count chunk)))
+ +0
+ bits))
+
+(def: #export (capacity bits)
+ (-> Bits Nat)
+ (|> bits array.size (n/* chunk-size)))
+
+(def: #export (empty? bits)
+ (-> Bits Bool)
+ (n/= +0 (size bits)))
+
+(def: #export (get index bits)
+ (-> Nat Bits Bool)
+ (let [[chunk-index bit-index] (n//% chunk-size index)]
+ (.and (n/< (array.size bits) chunk-index)
+ (|> (array.read chunk-index bits)
+ (maybe.default empty-chunk)
+ (bit.set? bit-index)))))
+
+(def: (chunk idx bits)
+ (-> Nat Bits Chunk)
+ (if (n/< (array.size bits) idx)
+ (|> bits (array.read idx) (maybe.default empty-chunk))
+ empty-chunk))
+
+(do-template [<name> <op>]
+ [(def: #export (<name> index input)
+ (-> Nat Bits Bits)
+ (let [[chunk-index bit-index] (n//% chunk-size index)]
+ (loop [size|output (n/max (n/inc chunk-index)
+ (array.size input))
+ output ..empty]
+ (let [idx|output (n/dec size|output)]
+ (if (n/> +0 size|output)
+ (case (|> (chunk idx|output input)
+ (cond> [(new> (n/= chunk-index idx|output))]
+ [(<op> bit-index)]
+
+ ## else
+ []))
+ +0
+ ## TODO: Remove 'no-op' once new-luxc is the official compiler.
+ (let [no-op (recur (n/dec size|output) output)]
+ no-op)
+
+ chunk
+ (|> (if (is ..empty output)
+ (: Bits (array.new size|output))
+ output)
+ (array.write idx|output chunk)
+ (recur (n/dec size|output))))
+ output)))))]
+
+ [set bit.set]
+ [clear bit.clear]
+ [flip bit.flip]
+ )
+
+(def: #export (intersects? reference sample)
+ (-> Bits Bits Bool)
+ (let [chunks (n/min (array.size reference)
+ (array.size sample))]
+ (loop [idx +0]
+ (if (n/< chunks idx)
+ (.or (|> (chunk idx sample)
+ (bit.and (chunk idx reference))
+ (n/= empty-chunk)
+ .not)
+ (recur (n/inc idx)))
+ false))))
+
+(def: #export (not input)
+ (-> Bits Bits)
+ (case (array.size input)
+ +0
+ ..empty
+
+ size|output
+ (loop [size|output size|output
+ output ..empty]
+ (let [idx (n/dec size|output)]
+ (case (bit.not (chunk idx input))
+ +0
+ (recur (n/dec size|output) output)
+
+ chunk
+ (if (n/> +0 size|output)
+ (|> (if (is ..empty output)
+ (: Bits (array.new size|output))
+ output)
+ (array.write idx chunk)
+ (recur (n/dec size|output)))
+ output))))))
+
+(do-template [<name> <op>]
+ [(def: #export (<name> param subject)
+ (-> Bits Bits Bits)
+ (case (n/max (array.size param)
+ (array.size subject))
+ +0
+ ..empty
+
+ size|output
+ (loop [size|output size|output
+ output ..empty]
+ (let [idx (n/dec size|output)]
+ (if (n/> +0 size|output)
+ (case (<op> (chunk idx param) (chunk idx subject))
+ +0
+ (recur (n/dec size|output) output)
+
+ chunk
+ (|> (if (is ..empty output)
+ (: Bits (array.new size|output))
+ output)
+ (array.write idx chunk)
+ (recur (n/dec size|output))))
+ output)))))]
+
+ [and bit.and]
+ [or bit.or]
+ [xor bit.xor]
+ )
+
+(struct: #export _ (Eq Bits)
+ (def: (= reference sample)
+ (let [size|= (n/max (array.size reference)
+ (array.size sample))]
+ (loop [idx +0]
+ (if (n/< size|= idx)
+ (.and (n/= (chunk idx reference)
+ (chunk idx sample))
+ (recur (n/inc idx)))
+ true)))))
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index 1e18af14e..d6001b3a6 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -58,6 +58,7 @@
)
(def: #export (log' base input)
+ (-> Frac Frac Frac)
(f// (log base)
(log input)))
@@ -75,12 +76,7 @@
(pow 2.0 catB))))
(do-template [<type> <mod> <gcd> <lcm> <zero> <*> </> <->]
- [(def: (<mod> param subject)
- (-> <type> <type> <type>)
- (let [exact (|> subject (</> param) (<*> param))]
- (|> subject (<-> exact))))
-
- (def: #export (<gcd> a b)
+ [(def: #export (<gcd> a b)
{#.doc "Greatest Common Divisor."}
(-> <type> <type> <type>)
(case b
diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux
index 7618a3a55..7fadcd8b3 100644
--- a/stdlib/source/lux/math/modular.lux
+++ b/stdlib/source/lux/math/modular.lux
@@ -49,15 +49,6 @@
(#e.Error error)
(p.fail error)))
-(def: (i/mod (^|> modulus [to-int])
- value)
- (All [m] (-> (Modulus m) Int Int))
- (let [raw (i/% modulus value)]
- (if (i/< 0 raw)
- (let [shift (if (i/< 0 modulus) i/- i/+)]
- (|> raw (shift modulus)))
- raw)))
-
(def: intL
(Lexer Int)
(p.codec number.Codec<Text,Int>
@@ -73,7 +64,7 @@
(def: #export (mod modulus)
(All [m] (-> (Modulus m) (-> Int (Mod m))))
(function [value]
- (@abstraction {#remainder (i/mod modulus value)
+ (@abstraction {#remainder (i/mod (to-int modulus) value)
#modulus modulus})))
(def: #export (un-mod modular)
@@ -137,7 +128,7 @@
[subject _] (@representation subject)]
(@abstraction {#remainder (|> subject
(<op> param)
- (i/mod modulus))
+ (i/mod (to-int modulus)))
#modulus modulus})))]
[m/+ i/+]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-07 00:26:23 +0000