diff options
author | Eduardo Julian | 2017-12-31 00:51:30 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-12-31 00:51:30 -0400 |
commit | 8f071917892ac919b91da12c2bf02d5d9b79f81a (patch) | |
tree | 8e5db500499241f6637cb1c5877314d4405390f6 /stdlib/source | |
parent | 59d674d660b4e52ec54ef046024b850b4eeb7a0f (diff) |
- Added bit-sets.
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux.lux | 13 | ||||
-rw-r--r-- | stdlib/source/lux/control/pipe.lux | 48 | ||||
-rw-r--r-- | stdlib/source/lux/data/bit.lux | 5 | ||||
-rw-r--r-- | stdlib/source/lux/data/coll/bits.lux | 165 | ||||
-rw-r--r-- | stdlib/source/lux/math.lux | 8 | ||||
-rw-r--r-- | stdlib/source/lux/math/modular.lux | 13 |
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/+] |