diff options
Diffstat (limited to 'stdlib/source')
48 files changed, 644 insertions, 667 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 4c52bf00f..795133b33 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,8 +1,8 @@ ## Basic types ("lux def" dummy-cursor ("lux check" (+2 (+0 "#Text" (+0)) - (+2 (+0 "#Nat" (+0)) - (+0 "#Nat" (+0)))) + (+2 (+0 "#I64" (+1 (+0 "#Nat" (+0)) (+0))) + (+0 "#I64" (+1 (+0 "#Nat" (+0)) (+0))))) ["" +0 +0]) [["" +0 +0] (+10 (+1 [[["" +0 +0] (+7 ["lux" "export?"])] @@ -22,7 +22,7 @@ (+1 [[dummy-cursor (+7 ["lux" "doc"])] [dummy-cursor (+5 "The type of things whose type does not matter. - It can be used to write functions or data-structures that can take, or return, anything.")]] + It can be used to write functions or data-structures that can take, or return, anything.")]] (+0)))))]) ## (type: Bottom @@ -38,7 +38,7 @@ (+1 [[dummy-cursor (+7 ["lux" "doc"])] [dummy-cursor (+5 "The type of things whose type is unknown or undefined. - Useful for expressions that cause errors or other \"extraordinary\" conditions.")]] + Useful for expressions that cause errors or other \"extraordinary\" conditions.")]] (+0)))))]) ## (type: (List a) @@ -77,9 +77,22 @@ [dummy-cursor (+5 "Your standard, run-of-the-mill boolean values.")]] #Nil))))]) +("lux def" I64 + (+10 ["lux" "I64"] + (+7 (+0) + (+0 "#I64" (#Cons (+4 +1) #Nil)))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "64-bit integers without any semantics.")]] + #Nil))))]) + ("lux def" Nat (+10 ["lux" "Nat"] - (+0 "#Nat" #Nil)) + (+0 "#I64" (#Cons (+0 "#Nat" #Nil) #Nil))) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] @@ -88,12 +101,12 @@ (#Cons [[dummy-cursor (+7 ["lux" "doc"])] [dummy-cursor (+5 "Natural numbers (unsigned integers). - They start at zero (+0) and extend in the positive direction.")]] + They start at zero (+0) and extend in the positive direction.")]] #Nil))))]) ("lux def" Int (+10 ["lux" "Int"] - (+0 "#Int" #Nil)) + (+0 "#I64" (#Cons (+0 "#Int" #Nil) #Nil))) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] @@ -103,30 +116,30 @@ [dummy-cursor (+5 "Your standard, run-of-the-mill integer numbers.")]] #Nil))))]) -("lux def" Frac - (+10 ["lux" "Frac"] - (+0 "#Frac" #Nil)) +("lux def" Deg + (+10 ["lux" "Deg"] + (+0 "#I64" (#Cons (+0 "#Deg" #Nil) #Nil))) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] (#Cons [[dummy-cursor (+7 ["lux" "export?"])] [dummy-cursor (+0 true)]] (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] + [dummy-cursor (+5 "Fractional numbers that live in the interval [0,1). + + Useful for probability, and other domains that work within that interval.")]] #Nil))))]) -("lux def" Deg - (+10 ["lux" "Deg"] - (+0 "#Deg" #Nil)) +("lux def" Frac + (+10 ["lux" "Frac"] + (+0 "#Frac" #Nil)) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] (#Cons [[dummy-cursor (+7 ["lux" "export?"])] [dummy-cursor (+0 true)]] (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "Fractional numbers that live in the interval [0,1). - - Useful for probability, and other domains that work within that interval.")]] + [dummy-cursor (+5 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] #Nil))))]) ("lux def" Text @@ -152,7 +165,7 @@ (#Cons [[dummy-cursor (+7 ["lux" "doc"])] [dummy-cursor (+5 "An identifier. - It is used as part of Lux syntax to represent symbols and tags.")]] + It is used as part of Lux syntax to represent symbols and tags.")]] #Nil))))]) ## (type: (Maybe a) @@ -1119,20 +1132,14 @@ (#.Cons export-meta #.Nil)) (#Function Nat (#Function Nat Nat)) - ("lux coerce" Nat - ("lux int +" - ("lux coerce" Int subject) - ("lux coerce" Int param)))) + ("lux i64 +" param subject)) (def:'' (n/- param subject) (#.Cons (doc-meta "Nat(ural) substraction.") (#.Cons export-meta #.Nil)) (#Function Nat (#Function Nat Nat)) - ("lux coerce" Nat - ("lux int -" - ("lux coerce" Int subject) - ("lux coerce" Int param)))) + ("lux i64 -" param subject)) (def:'' (n/* param subject) (#.Cons (doc-meta "Nat(ural) multiplication.") @@ -2201,28 +2208,24 @@ (list [(tag$ ["lux" "doc"]) (text$ "Nat(ural) equality.")]) (-> Nat Nat Bool) - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test))) + ("lux i64 =" test subject)) (def:''' (high-bits value) (list) - (-> Nat Int) - ("lux coerce" Int ("lux bit logical-right-shift" value +32))) + (-> ($' I64 Top) I64) + ("lux i64 logical-right-shift" +32 value)) (def:''' low-mask (list) - Nat - ("lux coerce" Nat - ("lux int -" - ("lux coerce" Int - ("lux bit left-shift" +1 +32)) - 1))) + I64 + (|> +1 + ("lux i64 left-shift" +32) + ("lux i64 -" +1))) (def:''' (low-bits value) (list) - (-> Nat Int) - ("lux coerce" Int ("lux bit and" value low-mask))) + (-> ($' I64 Top) I64) + ("lux i64 and" low-mask value)) (def:''' #export (n/< test subject) (list [(tag$ ["lux" "doc"]) @@ -2232,7 +2235,7 @@ subjectH (high-bits subject)] (if ("lux int <" subjectH testH) true - (if ("lux int =" subjectH testH) + (if ("lux i64 =" testH subjectH) ("lux int <" (low-bits subject) (low-bits test)) @@ -2244,9 +2247,7 @@ (-> Nat Nat Bool) (if (n/< test subject) true - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test)))) + ("lux i64 =" test subject))) (def:''' #export (n/> test subject) (list [(tag$ ["lux" "doc"]) @@ -2260,9 +2261,7 @@ (-> Nat Nat Bool) (if (n/< subject test) true - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test)))) + ("lux i64 =" test subject))) (macro:' #export (do-template tokens) (list [(tag$ ["lux" "doc"]) @@ -2272,8 +2271,8 @@ (-> Int Int) (i/+ <diff>))] - [i/inc 1] - [i/dec -1])")]) + [inc 1] + [dec -1])")]) ("lux case" tokens {(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) ("lux case" [(monad/map Monad<Maybe> get-name bindings) @@ -2299,9 +2298,7 @@ (list [(tag$ ["lux" "doc"]) (text$ "Deg(ree) equality.")]) (-> Deg Deg Bool) - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test))) + ("lux i64 =" test subject)) (def:''' #export (d/< test subject) (list [(tag$ ["lux" "doc"]) @@ -2317,9 +2314,7 @@ (if (n/< ("lux coerce" Nat test) ("lux coerce" Nat subject)) true - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test)))) + ("lux i64 =" test subject))) (def:''' #export (d/> test subject) (list [(tag$ ["lux" "doc"]) @@ -2333,9 +2328,7 @@ (-> Deg Deg Bool) (if (d/< subject test) true - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test)))) + ("lux i64 =" test subject))) (do-template [<type> <eq-proc> <lt-proc> <eq-name> <lt-name> <lte-name> <gt-name> <gte-name> @@ -2374,7 +2367,7 @@ true (<eq-proc> subject test)))] - [ Int "lux int =" "lux int <" i/= i/< i/<= i/> i/>= + [ Int "lux i64 =" "lux int <" i/= i/< i/<= i/> i/>= "Int(eger) equality." "Int(eger) less-than." "Int(eger) less-than-equal." "Int(eger) greater-than." "Int(eger) greater-than-equal."] [Frac "lux frac =" "lux frac <" f/= f/< f/<= f/> f/>= @@ -2389,27 +2382,18 @@ (if (n/< param subject) +0 +1) - (let' [quotient ("lux bit left-shift" - ("lux coerce" Nat - ("lux int /" - ("lux coerce" Int - ("lux bit logical-right-shift" - subject - +1)) - ("lux coerce" Int param))) - +1) - remainder ("lux coerce" Nat - ("lux int -" - ("lux coerce" Int subject) - ("lux int *" - ("lux coerce" Int quotient) - ("lux coerce" Int param))))] + (let' [quotient ("lux i64 left-shift" + +1 + ("lux int /" + ("lux i64 logical-right-shift" +1 subject) + ("lux coerce" Int param))) + flat ("lux int *" + ("lux coerce" Int quotient) + ("lux coerce" Int param)) + remainder ("lux i64 -" flat subject)] (if (n/< param remainder) quotient - ("lux coerce" Nat - ("lux int +" - ("lux coerce" Int quotient) - 1)))))) + ("lux i64 +" +1 quotient))))) (def:''' #export (n/% param subject) (list [(tag$ ["lux" "doc"]) @@ -2418,48 +2402,59 @@ (let' [flat ("lux int *" ("lux coerce" Int (n// param subject)) ("lux coerce" Int param))] - ("lux coerce" Nat - ("lux int -" - ("lux coerce" Int subject) - flat)))) + ("lux i64 -" flat subject))) (do-template [<type> <name> <op> <doc>] [(def:''' #export (<name> param subject) (list [(tag$ ["lux" "doc"]) (text$ <doc>)]) (-> <type> <type> <type>) - ("lux coerce" Deg - (<op> ("lux coerce" Int subject) - ("lux coerce" Int param))))] + (<op> param subject))] - [ Deg d/+ "lux int +" "Deg(ree) addition."] - [ Deg d/- "lux int -" "Deg(ree) substraction."] + [ Int i/+ "lux i64 +" "Int(eger) addition."] + [ Int i/- "lux i64 -" "Int(eger) substraction."] + + [ Deg d/+ "lux i64 +" "Deg(ree) addition."] + [ Deg d/- "lux i64 -" "Deg(ree) substraction."] + ) + +(do-template [<type> <name> <op> <doc>] + [(def:''' #export (<name> param subject) + (list [(tag$ ["lux" "doc"]) + (text$ <doc>)]) + (-> <type> <type> <type>) + (<op> subject param))] + + [ Int i/* "lux int *" "Int(eger) multiplication."] + [ Int i// "lux int /" "Int(eger) division."] + [ Int i/% "lux int %" "Int(eger) remainder."] + + [Frac f/+ "lux frac +" "Frac(tion) addition."] + [Frac f/- "lux frac -" "Frac(tion) substraction."] + [Frac f/* "lux frac *" "Frac(tion) multiplication."] + [Frac f// "lux frac /" "Frac(tion) division."] + [Frac f/% "lux frac %" "Frac(tion) remainder."] ) (def:''' #export (d/* param subject) (list [(tag$ ["lux" "doc"]) (text$ "Deg(ree) multiplication.")]) (-> Deg Deg Deg) - (let' [subjectH (high-bits ("lux coerce" Nat subject)) - subjectL (low-bits ("lux coerce" Nat subject)) - paramH (high-bits ("lux coerce" Nat param)) - paramL (low-bits ("lux coerce" Nat param)) - bottom ("lux coerce" Int - ("lux bit logical-right-shift" - ("lux coerce" Nat ("lux int *" subjectL paramL)) - +32)) - middle ("lux int +" + (let' [subjectH (high-bits subject) + subjectL (low-bits subject) + paramH (high-bits param) + paramL (low-bits param) + bottom (|> subjectL + ("lux int *" paramL) + ("lux i64 logical-right-shift" +32)) + middle ("lux i64 +" ("lux int *" subjectH paramL) ("lux int *" subjectL paramH)) top ("lux int *" subjectH paramH)] - ("lux coerce" Deg - ("lux int +" - (high-bits - ("lux coerce" Nat - ("lux int +" - bottom - middle))) - top)))) + (|> bottom + ("lux i64 +" middle) + high-bits + ("lux i64 +" top)))) (def:''' least-significant-bit-mask (list) Nat +1) @@ -2467,32 +2462,26 @@ (list) (-> Nat Nat (#Product Nat Nat)) (if (|> remaining - ("lux bit and" least-significant-bit-mask) - ("lux coerce" Int) - ("lux int =" 0)) + ("lux i64 and" least-significant-bit-mask) + ("lux i64 =" +0)) (without-trailing-zeroes - (|> count - ("lux coerce" Int) - ("lux int +" 1) - ("lux coerce" Nat)) - ("lux bit logical-right-shift" remaining +1)) + ("lux i64 +" +1 count) + ("lux i64 logical-right-shift" +1 remaining)) [count remaining])) (def:''' #export (d// param subject) (list [(tag$ ["lux" "doc"]) (text$ "Deg(ree) division.")]) (-> Deg Deg Deg) - (if (|> param ("lux coerce" Int) ("lux int =" 0)) + (if ("lux i64 =" 0 param) ("lux io error" "Cannot divide Deg by zero!") (let' [[trailing-zeroes remaining] (without-trailing-zeroes +0 ("lux coerce" Nat param)) - [trailing-zeroes denominator] (if (|> trailing-zeroes ("lux coerce" Int) ("lux int =" 0)) - [+1 ("lux bit logical-right-shift" remaining +1)] - [trailing-zeroes remaining]) - shift ("lux coerce" Nat - ("lux int -" - 64 - ("lux coerce" Int trailing-zeroes))) - numerator ("lux bit left-shift" +1 shift)] + [trailing-zeroes denominator] ("lux check" (#Product 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)] ("lux coerce" Deg ("lux int *" ("lux coerce" Int subject) @@ -2508,26 +2497,6 @@ (n/% ("lux coerce" Nat subject) ("lux coerce" Nat param)))) -(do-template [<type> <name> <op> <doc>] - [(def:''' #export (<name> param subject) - (list [(tag$ ["lux" "doc"]) - (text$ <doc>)]) - (-> <type> <type> <type>) - (<op> subject param))] - - [ Int i/+ "lux int +" "Int(eger) addition."] - [ Int i/- "lux int -" "Int(eger) substraction."] - [ Int i/* "lux int *" "Int(eger) multiplication."] - [ Int i// "lux int /" "Int(eger) division."] - [ Int i/% "lux int %" "Int(eger) remainder."] - - [Frac f/+ "lux frac +" "Frac(tion) addition."] - [Frac f/- "lux frac -" "Frac(tion) substraction."] - [Frac f/* "lux frac *" "Frac(tion) multiplication."] - [Frac f// "lux frac /" "Frac(tion) division."] - [Frac f/% "lux frac %" "Frac(tion) remainder."] - ) - (def:''' #export (d/scale param subject) (list [(tag$ ["lux" "doc"]) (text$ "Deg(ree) scale.")]) @@ -2546,7 +2515,7 @@ (n// remaining ("lux case" trailing-zeroes {+0 ("lux coerce" Nat -1) - _ ("lux bit left-shift" +1 (n/- trailing-zeroes +64))}))))) + _ ("lux i64 left-shift" (n/- trailing-zeroes +64) +1)}))))) (do-template [<name> <type> <test> <doc>] [(def:''' #export (<name> left right) @@ -5117,7 +5086,7 @@ (macro: #export (update@ tokens) {#.doc "## Modifies the value of a record at a given tag, based on some function. - (update@ #age i/inc person) + (update@ #age inc person) ## Can also work with multiple levels of nesting: (update@ [#foo #bar #baz] func my-record) @@ -5256,8 +5225,8 @@ (-> <from> <to>) (<proc> [n]))] - [frac-to-int Frac Int "lux frac to-int"] - [int-to-frac Int Frac "lux int to-frac"] + [frac-to-int Frac Int "lux frac int"] + [int-to-frac Int Frac "lux int frac"] ) (def: (find-baseline-column code) @@ -5314,34 +5283,31 @@ )] ($_ text/compose "\"" escaped "\""))) -(do-template [<name> <op> <one> <type> <doc>] - [(def: #export (<name> value) +(do-template [<name> <special> <doc>] + [(def: #export <name> {#.doc <doc>} - (-> <type> <type>) - (<op> <one> value))] + (All [s] (-> (I64 s) (I64 s))) + (|>> (<special> +1)))] - [i/inc i/+ 1 Int "[Int] Increment function."] - [i/dec i/- 1 Int "[Int] Decrement function."] - [n/inc n/+ +1 Nat "[Nat] Increment function."] - [n/dec n/- +1 Nat "[Nat] Decrement function."] + [inc "lux i64 +" "Increment function."] + [dec "lux i64 -" "Decrement function."] ) (def: tag/encode (-> Ident Text) (|>> ident/encode (text/compose "#"))) -(do-template [<name> <from> <to>] +(do-template [<name> <to>] [(def: #export <name> - (-> <from> <to>) + (-> (I64 Top) <to>) (|>> (:! <to>)))] - [int-to-nat Int Nat] - [nat-to-int Nat Int] + [i64 I64] + [nat Nat] + [int Int] + [deg Deg] ) -(def: #export frac-to-nat (|>> frac-to-int int-to-nat)) -(def: #export nat-to-frac (|>> nat-to-int int-to-frac)) - (def: (repeat n x) (All [a] (-> Int a (List a))) (if (i/> 0 n) @@ -5351,9 +5317,9 @@ (def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column]) (-> Nat Cursor Cursor Text) (if (n/= old-line new-line) - (text/join (repeat (nat-to-int (n/- old-column new-column)) " ")) - (let [extra-lines (text/join (repeat (nat-to-int (n/- old-line new-line)) "\n")) - space-padding (text/join (repeat (nat-to-int (n/- baseline new-column)) " "))] + (text/join (repeat (.int (n/- old-column new-column)) " ")) + (let [extra-lines (text/join (repeat (.int (n/- old-line new-line)) "\n")) + space-padding (text/join (repeat (.int (n/- baseline new-column)) " "))] (text/compose extra-lines space-padding)))) (def: (text/size x) @@ -5366,7 +5332,7 @@ (def: (delim-update-cursor [file line column]) (-> Cursor Cursor) - [file line (n/inc column)]) + [file line (inc column)]) (def: rejoin-all-pairs (-> (List [Code Code]) (List Code)) @@ -5437,7 +5403,7 @@ (loop [count 0 x init] (if (< 10 count) - (recur (i/inc count) (f x)) + (recur (inc count) (f x)) x)))"} (return (list (` [(~ cursor-code) (#.Text (~ (|> tokens @@ -5502,7 +5468,7 @@ (loop [count 0 x init] (if (< 10 count) - (recur (i/inc count) (f x)) + (recur (inc count) (f x)) x)) "Loops can also be given custom names." @@ -5510,7 +5476,7 @@ [count 0 x init] (if (< 10 count) - (my-loop (i/inc count) (f x)) + (my-loop (inc count) (f x)) x)))} (let [?params (case tokens (^ (list name [_ (#Tuple bindings)] body)) @@ -5900,7 +5866,7 @@ (#Cons x xs') (if (n/= +0 idx) (#Some x) - (list-at (n/dec idx) xs')))) + (list-at (dec idx) xs')))) (macro: #export ($ tokens) {#.doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." @@ -5955,7 +5921,7 @@ (macro: #export (^|> tokens) {#.doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." (case input - (^|> value [n/inc (n/% +10) (n/max +1)]) + (^|> value [inc (n/% +10) (n/max +1)]) (foo value)))} (case tokens (^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] [_ (#Tuple steps)]))] body branches)) @@ -6330,31 +6296,27 @@ [Int i//% i// i/%] ) -(def: (to-significand value) - (-> Nat Frac) - (|> ("lux bit logical-right-shift" value +11) - (:! Int) - int-to-frac)) +(def: to-significand + (-> (I64 Top) Frac) + (|>> ("lux i64 logical-right-shift" +11) + int-to-frac)) -(def: deg-denominator Frac (to-significand (:! Nat -1))) +(def: deg-denominator Frac (to-significand -1)) (def: #export (frac-to-deg input) (-> Frac Deg) (let [abs (if (f/< 0.0 input) (f/* -1.0 input) input)] - (:! Deg - ("lux bit left-shift" - (|> abs - (f/% 1.0) - (f/* deg-denominator) - frac-to-int - (:! Nat)) - +11)))) + (|> abs + (f/% 1.0) + (f/* deg-denominator) + frac-to-int + ("lux i64 left-shift" +11)))) (def: #export deg-to-frac (-> Deg Frac) - (|>> (:! Nat) to-significand (f// deg-denominator))) + (|>> to-significand (f// deg-denominator))) (macro: #export (alias: tokens) (case tokens diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index 4fdb2c207..1e512d642 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -327,11 +327,11 @@ g!actor-refs (: (List Code) (if (list.empty? actor-vars) (list) - (|> actor-vars list.size n/dec + (|> actor-vars list.size dec (list.n/range +0) (list/map (|>> code.nat (~) ($) (`)))))) ref-replacements (|> (if (list.empty? actor-vars) (list) - (|> actor-vars list.size n/dec + (|> actor-vars list.size dec (list.n/range +0) (list/map (|>> code.nat (~) ($) (`))))) (: (List Code)) (list.zip2 g!all-vars) diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index a2311d272..15bad9910 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -9,9 +9,9 @@ (concurrency [atom #+ Atom atom]) (type abstract))) -(def: #export parallelism-level +(def: #export parallelism Nat - ("lux process parallelism-level")) + ("lux process parallelism")) (abstract: #export (Promise a) {#.doc "Represents values produced by asynchronous computations (unlike IO, which is synchronous)."} diff --git a/stdlib/source/lux/concurrency/semaphore.lux b/stdlib/source/lux/concurrency/semaphore.lux index 50a1a621c..c9ac32fcb 100644 --- a/stdlib/source/lux/concurrency/semaphore.lux +++ b/stdlib/source/lux/concurrency/semaphore.lux @@ -33,7 +33,7 @@ (case (get@ #open-positions state) +0 [false (update@ #waiting-list (|>> (#.Cons signal)) state)] - _ [true (update@ #open-positions n/dec + _ [true (update@ #open-positions dec state)]))] success? (atom.compare-and-swap state state' semaphore) _ (if ready? @@ -53,7 +53,7 @@ #let [[?signal state'] (: [(Maybe (Promise Top)) State] (case (get@ #waiting-list state) #.Nil - [#.None (update@ #open-positions n/inc state)] + [#.None (update@ #open-positions inc state)] (#.Cons head tail) [(#.Some head) (set@ #waiting-list tail state)]))] @@ -120,7 +120,7 @@ (if (n/< times step) (do promise.Monad<Promise> [_ (signal turnstile)] - (recur (n/inc step))) + (recur (inc step))) (:: promise.Monad<Promise> wrap [])))) (do-template [<phase> <update> <goal> <turnstile>] @@ -135,8 +135,8 @@ (wrap []))] (wait (get@ <turnstile> barrier))))] - [start n/inc limit #start-turnstile] - [end n/dec +0 #end-turnstile] + [start inc limit #start-turnstile] + [end dec +0 #end-turnstile] ) (def: #export (block barrier) diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux index 471c6bd2b..833a01c57 100644 --- a/stdlib/source/lux/control/comonad.lux +++ b/stdlib/source/lux/control/comonad.lux @@ -29,7 +29,7 @@ {#.doc (doc "A co-monadic parallel to the \"do\" macro." (let [square (function (_ n) (i/* n n))] (be CoMonad<Stream> - [inputs (iterate i/inc 2)] + [inputs (iterate inc 2)] (square (head inputs)))))} (case tokens (#.Cons comonad (#.Cons [_ (#.Tuple bindings)] (#.Cons body #.Nil))) diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux index 9a1ceb3b9..736296920 100644 --- a/stdlib/source/lux/control/monad.lux +++ b/stdlib/source/lux/control/monad.lux @@ -22,7 +22,7 @@ counter (#.Cons _ xs') - (recur (n/inc counter) xs')))) + (recur (inc counter) xs')))) (def: (reverse xs) (All [a] diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 3c1022fc8..88f2eb20d 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -139,7 +139,7 @@ (if (n/> +0 n) (do Monad<Parser> [x p - xs (exactly (n/dec n) p)] + xs (exactly (dec n) p)] (wrap (#.Cons x xs))) (:: Monad<Parser> wrap (list)))) @@ -163,7 +163,7 @@ (#e.Success [input' x]) (run input' (do Monad<Parser> - [xs (at-most (n/dec n) p)] + [xs (at-most (dec n) p)] (wrap (#.Cons x xs)))) )) (:: Monad<Parser> wrap (list)))) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index 4e84e7832..19d67ce7d 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -19,7 +19,7 @@ (|> 20 (i/* 3) (i/+ 4) - (new> 0 i/inc)))} + (new> 0 inc)))} (case (list.reverse tokens) (^ (list& _ r-body)) (wrap (list (` (|> (~+ (list.reverse r-body)))))) @@ -66,7 +66,7 @@ "Both the testing and calculating steps are pipes and must be given inside tuples." (|> 1 (loop> [(i/< 10)] - [i/inc])))} + [inc])))} (with-gensyms [g!temp] (wrap (list (` (loop [(~ g!temp) (~ prev)] (if (|> (~ g!temp) (~+ test)) @@ -82,7 +82,7 @@ (do> Monad<Identity> [(i/* 3)] [(i/+ 4)] - [i/inc])))} + [inc])))} (with-gensyms [g!temp] (case (list.reverse steps) (^ (list& last-step prev-steps)) @@ -102,7 +102,7 @@ {#.doc (doc "Non-updating pipes." "Will generate piped computations, but their results will not be used in the larger scope." (|> 5 - (exec> [int-to-nat %n log!]) + (exec> [.nat %n log!]) (i/* 10)))} (with-gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ prev)] @@ -115,7 +115,7 @@ "Allows to run multiple pipelines for a value and gives you a tuple of the outputs." (|> 5 (tuple> [(i/* 10)] - [i/dec (i// 2)] + [dec (i// 2)] [Int/encode])) "Will become: [50 2 \"5\"]")} (with-gensyms [g!temp] diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux index ae5b6e55d..e89cf0c9d 100644 --- a/stdlib/source/lux/data/bit.lux +++ b/stdlib/source/lux/data/bit.lux @@ -3,33 +3,41 @@ (def: #export width Nat +64) ## [Values] -(do-template [<name> <type> <op> <doc>] +(do-template [<name> <op> <doc>] + [(def: #export (<name> param subject) + {#.doc <doc>} + (All [s] (-> (I64 s) (I64 s) (I64 s))) + (<op> param subject))] + + [and "lux i64 and" "Bitwise and."] + [or "lux i64 or" "Bitwise or."] + [xor "lux i64 xor" "Bitwise xor."] + ) + +(do-template [<name> <op> <doc>] [(def: #export (<name> param subject) {#.doc <doc>} - (-> Nat <type> <type>) - (<op> subject param))] - - [and Nat "lux bit and" "Bitwise and."] - [or Nat "lux bit or" "Bitwise or."] - [xor Nat "lux bit xor" "Bitwise xor."] - [left-shift Nat "lux bit left-shift" "Bitwise left-shift."] - [logical-right-shift Nat "lux bit logical-right-shift" "Unsigned bitwise logical-right-shift."] - [arithmetic-right-shift Int "lux bit arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."] + (All [s] (-> Nat (I64 s) (I64 s))) + (<op> param subject))] + + [left-shift "lux i64 left-shift" "Bitwise left-shift."] + [logical-right-shift "lux i64 logical-right-shift" "Unsigned bitwise logical-right-shift."] + [arithmetic-right-shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."] ) (alias: right-shift logical-right-shift) (def: (add-shift shift value) (-> Nat Nat Nat) - (|> value (logical-right-shift shift) (n/+ value))) + (|> value (right-shift shift) (n/+ value))) (def: #export (count subject) {#.doc "Count the number of 1s in a bit-map."} - (-> Nat Nat) - (let [count' (n/- (|> subject (logical-right-shift +1) (and +6148914691236517205)) - subject)] + (-> (I64 Top) Nat) + (let [count' (n/- (|> subject (right-shift +1) (and +6148914691236517205) i64) + (i64 subject))] (|> count' - (logical-right-shift +2) (and +3689348814741910323) (n/+ (and +3689348814741910323 count')) + (right-shift +2) (and +3689348814741910323) (n/+ (and +3689348814741910323 count')) (add-shift +4) (and +1085102592571150095) (add-shift +8) (add-shift +16) @@ -38,43 +46,44 @@ (def: #export not {#.doc "Bitwise negation."} - (-> Nat Nat) - (let [mask (int-to-nat -1)] - (xor mask))) + (All [s] (-> (I64 s) (I64 s))) + (xor (:! I64 -1))) + +(def: (flag idx) + (-> Nat I64) + (|> +1 (:! I64) (left-shift idx))) (def: #export (clear idx input) {#.doc "Clear bit at given index."} - (-> Nat Nat Nat) - (..and (..not (left-shift idx +1)) - input)) + (All [s] (-> Nat (I64 s) (I64 s))) + (|> idx flag ..not (..and input))) (do-template [<name> <op> <doc>] [(def: #export (<name> idx input) {#.doc <doc>} - (-> Nat Nat Nat) - (<op> (left-shift idx +1) input))] + (All [s] (-> Nat (I64 s) (I64 s))) + (|> idx flag (<op> input)))] [set ..or "Set bit at given index."] [flip ..xor "Flip bit at given index."] ) (def: #export (set? idx input) - (-> Nat Nat Bool) - (|> input (..and (left-shift idx +1)) (n/= +0) .not)) + (-> Nat (I64 Top) Bool) + (|> input (:! I64) (..and (flag idx)) (n/= +0) .not)) (do-template [<name> <main> <comp>] [(def: #export (<name> distance input) - (-> Nat Nat Nat) - (..or (<main> distance input) - (<comp> (n/- (n/% width distance) - width) - input)))] - - [rotate-left left-shift logical-right-shift] - [rotate-right logical-right-shift left-shift] + (All [s] (-> Nat (I64 s) (I64 s))) + (let [backwards-distance (n/- (n/% width distance) width)] + (|> input + (<comp> backwards-distance) + (..or (<main> distance input)))))] + + [rotate-left left-shift right-shift] + [rotate-right right-shift left-shift] ) -(def: #export (region-mask size offset) - (-> Nat Nat Nat) - (let [pattern (|> +1 (left-shift size) n/dec)] - (left-shift offset pattern))) +(def: #export (region size offset) + (-> Nat Nat I64) + (|> +1 (:! I64) (left-shift size) dec (left-shift offset))) diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux index 855c35d8e..dd3a94553 100644 --- a/stdlib/source/lux/data/coll/array.lux +++ b/stdlib/source/lux/data/coll/array.lux @@ -45,7 +45,7 @@ (#.Some value) (write (n/+ offset dest-start) value target))) dest-array - (list.n/range +0 (n/dec length))))) + (list.n/range +0 (dec length))))) (def: #export (occupied array) {#.doc "Finds out how many cells in an array are occupied."} @@ -56,7 +56,7 @@ count (#.Some _) - (n/inc count))) + (inc count))) +0 (list.indices (size array)))) @@ -88,12 +88,12 @@ (if (n/< arr-size idx) (case (read idx xs) #.None - (recur (n/inc idx)) + (recur (inc idx)) (#.Some x) (if (p x) (#.Some x) - (recur (n/inc idx)))) + (recur (inc idx)))) #.None)))) (def: #export (find+ p xs) @@ -105,12 +105,12 @@ (if (n/< arr-size idx) (case (read idx xs) #.None - (recur (n/inc idx)) + (recur (inc idx)) (#.Some x) (if (p idx x) (#.Some [idx x]) - (recur (n/inc idx)))) + (recur (inc idx)))) #.None)))) (def: #export (clone xs) @@ -129,19 +129,19 @@ (def: #export (from-list xs) (All [a] (-> (List a) (Array a))) (product.right (list/fold (function (_ x [idx arr]) - [(n/inc idx) (write idx x arr)]) + [(inc idx) (write idx x arr)]) [+0 (new (list.size xs))] xs))) -(def: underflow Nat (n/dec +0)) +(def: underflow Nat (dec +0)) (def: #export (to-list array) (All [a] (-> (Array a) (List a))) - (loop [idx (n/dec (size array)) + (loop [idx (dec (size array)) output #.Nil] (if (n/= underflow idx) output - (recur (n/dec idx) + (recur (dec idx) (case (read idx array) (#.Some head) (#.Cons head output) @@ -167,11 +167,10 @@ _ false))) true - (list.n/range +0 (n/dec sxs))))) + (list.n/range +0 (dec sxs))))) )) -(struct: #export Monoid<Array> (All [a] - (Monoid (Array a))) +(struct: #export Monoid<Array> (All [a] (Monoid (Array a))) (def: identity (new +0)) (def: (compose xs ys) @@ -194,7 +193,7 @@ (#.Some x) (write idx (f x) mb))) (new arr-size) - (list.n/range +0 (n/dec arr-size))) + (list.n/range +0 (dec arr-size))) )))) (struct: #export _ (Fold Array) @@ -205,8 +204,8 @@ (if (n/< arr-size idx) (case (read idx xs) #.None - (recur so-far (n/inc idx)) + (recur so-far (inc idx)) (#.Some value) - (recur (f value so-far) (n/inc idx))) + (recur (f value so-far) (inc idx))) so-far))))) diff --git a/stdlib/source/lux/data/coll/bits.lux b/stdlib/source/lux/data/coll/bits.lux index b2530627c..304076048 100644 --- a/stdlib/source/lux/data/coll/bits.lux +++ b/stdlib/source/lux/data/coll/bits.lux @@ -53,10 +53,10 @@ [(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) + (loop [size|output (n/max (inc chunk-index) (array.size input)) output ..empty] - (let [idx|output (n/dec size|output)] + (let [idx|output (dec size|output)] (if (n/> +0 size|output) (case (|> (chunk idx|output input) (cond> [(new> (n/= chunk-index idx|output))] @@ -66,7 +66,7 @@ [])) +0 ## TODO: Remove 'no-op' once new-luxc is the official compiler. - (let [no-op (recur (n/dec size|output) output)] + (let [no-op (recur (dec size|output) output)] no-op) chunk @@ -74,7 +74,7 @@ (: Bits (array.new size|output)) output) (array.write idx|output chunk) - (recur (n/dec size|output)))) + (recur (dec size|output)))) output)))))] [set bit.set] @@ -92,7 +92,7 @@ (bit.and (chunk idx reference)) (n/= empty-chunk) .not) - (recur (n/inc idx))) + (recur (inc idx))) false)))) (def: #export (not input) @@ -104,10 +104,10 @@ size|output (loop [size|output size|output output ..empty] - (let [idx (n/dec size|output)] + (let [idx (dec size|output)] (case (bit.not (chunk idx input)) +0 - (recur (n/dec size|output) output) + (recur (dec size|output) output) chunk (if (n/> +0 size|output) @@ -115,7 +115,7 @@ (: Bits (array.new size|output)) output) (array.write idx chunk) - (recur (n/dec size|output))) + (recur (dec size|output))) output)))))) (do-template [<name> <op>] @@ -129,18 +129,18 @@ size|output (loop [size|output size|output output ..empty] - (let [idx (n/dec size|output)] + (let [idx (dec size|output)] (if (n/> +0 size|output) (case (<op> (chunk idx param) (chunk idx subject)) +0 - (recur (n/dec size|output) output) + (recur (dec size|output) output) chunk (|> (if (is? ..empty output) (: Bits (array.new size|output)) output) (array.write idx chunk) - (recur (n/dec size|output)))) + (recur (dec size|output)))) output)))))] [and bit.and] @@ -156,5 +156,5 @@ (if (n/< size|= idx) (.and (n/= (chunk idx reference) (chunk idx sample)) - (recur (n/inc idx))) + (recur (inc idx))) true))))) diff --git a/stdlib/source/lux/data/coll/dictionary/ordered.lux b/stdlib/source/lux/data/coll/dictionary/ordered.lux index a099087f3..2feb18e0f 100644 --- a/stdlib/source/lux/data/coll/dictionary/ordered.lux +++ b/stdlib/source/lux/data/coll/dictionary/ordered.lux @@ -115,8 +115,8 @@ +0 (#.Some node) - (n/inc (<op> (recur (get@ #left node)) - (recur (get@ #right node)))))))] + (inc (<op> (recur (get@ #left node)) + (recur (get@ #right node)))))))] [size n/+] [depth n/max] diff --git a/stdlib/source/lux/data/coll/dictionary/unordered.lux b/stdlib/source/lux/data/coll/dictionary/unordered.lux index e0928e186..aad28249f 100644 --- a/stdlib/source/lux/data/coll/dictionary/unordered.lux +++ b/stdlib/source/lux/data/coll/dictionary/unordered.lux @@ -120,10 +120,10 @@ (def: (insert! idx value old-array) (All [a] (-> Index a (Array a) (Array a))) (let [old-size (array.size old-array)] - (|> (array.new (n/inc old-size)) + (|> (array.new (inc old-size)) (array.copy idx +0 old-array +0) (array.write idx value) - (array.copy (n/- idx old-size) idx old-array (n/inc idx))))) + (array.copy (n/- idx old-size) idx old-array (inc idx))))) ## Creates a copy of an array with an index set to a particular value. (def: (update! idx value array) @@ -138,15 +138,15 @@ ## Shrinks a copy of the array by removing the space at index. (def: (remove! idx array) (All [a] (-> Index (Array a) (Array a))) - (let [new-size (n/dec (array.size array))] + (let [new-size (dec (array.size array))] (|> (array.new new-size) (array.copy idx +0 array +0) - (array.copy (n/- idx new-size) (n/inc idx) array idx)))) + (array.copy (n/- idx new-size) (inc idx) array idx)))) ## Given a top-limit for indices, produces all indices in [0, R). (def: indices-for (-> Nat (List Index)) - (|>> n/dec (list.n/range +0))) + (|>> dec (list.n/range +0))) ## Increases the level-shift by the branching-exponent, to explore ## levels further down the tree. @@ -154,7 +154,7 @@ (-> Level Level) (n/+ branching-exponent)) -(def: hierarchy-mask BitMap (n/dec hierarchy-nodes-size)) +(def: hierarchy-mask BitMap (dec hierarchy-nodes-size)) ## Gets the branching-factor sized section of the hash corresponding ## to a particular level, and uses that as an index into the array. @@ -201,7 +201,7 @@ ## associated with it. (def: bit-position-mask (-> BitPosition BitMap) - n/dec) + dec) ## The index on the base array, based on it's bit-position. (def: (base-index bit-position bitmap) @@ -227,12 +227,12 @@ #.None [insertion-idx node] (#.Some sub-node) (if (n/= except-idx idx) [insertion-idx node] - [(n/inc insertion-idx) + [(inc insertion-idx) [(set-bit-position (->bit-position idx) bitmap) (array.write insertion-idx (#.Left sub-node) base)]]) ))) [+0 [clean-bitmap - (array.new (n/dec h-size))]] + (array.new (dec h-size))]] (list.indices (array.size h-array))))) ## When #Base nodes grow too large, they're promoted to #Hierarchy to @@ -248,7 +248,7 @@ (product.right (list/fold (function (_ hierarchy-idx (^@ default [base-idx h-array])) (if (bit-position-is-set? (->bit-position hierarchy-idx) bitmap) - [(n/inc base-idx) + [(inc base-idx) (case (array.read base-idx base) (#.Some (#.Left sub-node)) (array.write hierarchy-idx sub-node h-array) @@ -289,7 +289,7 @@ [_size sub-node] _ - [(n/inc _size) empty])] + [(inc _size) empty])] (#Hierarchy _size' (update! idx (put' (level-up level) hash key val Hash<k> sub-node) hierarchy))) @@ -342,7 +342,7 @@ (if (n/>= promotion-threshold base-count) ## If so, I promote it to a #Hierarchy node, and add the new ## KV-pair as a singleton node to it. - (#Hierarchy (n/inc base-count) + (#Hierarchy (inc base-count) (|> (promote-base put' Hash<k> level bitmap base) (array.write (level-index level hash) (put' (level-up level) hash key val Hash<k> empty)))) @@ -399,7 +399,7 @@ ## If so, perform it. (#Base (demote-hierarchy idx [h-size h-array])) ## Otherwise, just clear the space. - (#Hierarchy (n/dec h-size) (vacant! idx h-array))) + (#Hierarchy (dec h-size) (vacant! idx h-array))) ## But if the sub-removal yielded a non-empty node, then ## just update the hiearchy branch. (#Hierarchy h-size (update! idx sub-node' h-array))))))) diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index f6c19dcb9..f970ccf9f 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -76,8 +76,8 @@ <then>) <else>))] - [take (#.Cons [x (take (n/dec n) xs')]) #.Nil] - [drop (drop (n/dec n) xs') xs] + [take (#.Cons [x (take (dec n) xs')]) #.Nil] + [drop (drop (dec n) xs') xs] ) (do-template [<name> <then> <else>] @@ -106,7 +106,7 @@ [#.Nil #.Nil] (#.Cons [x xs']) - (let [[tail rest] (split (n/dec n) xs')] + (let [[tail rest] (split (dec n) xs')] [(#.Cons [x tail]) rest])) [#.Nil xs])) @@ -145,7 +145,7 @@ (All [a] (-> Nat a (List a))) (if (n/> +0 n) - (#.Cons [x (repeat (n/dec n) x)]) + (#.Cons [x (repeat (dec n) x)]) #.Nil)) (def: (iterate' f x) @@ -232,7 +232,7 @@ (#.Cons [x xs']) (if (n/= +0 i) (#.Some x) - (nth (n/dec i) xs')))) + (nth (dec i) xs')))) ## [Structures] (struct: #export (Eq<List> Eq<a>) @@ -303,21 +303,21 @@ xs')] ($_ compose (sort < pre) (list x) (sort < post))))) -(do-template [<name> <type> <lt> <inc> <gt> <dec>] +(do-template [<name> <type> <lt> <gt>] [(def: #export (<name> from to) {#.doc "Generates an inclusive interval of values [from, to]."} (-> <type> <type> (List <type>)) (cond (<lt> to from) - (list& from (<name> (<inc> from) to)) + (list& from (<name> (inc from) to)) (<gt> to from) - (list& from (<name> (<dec> from) to)) + (list& from (<name> (dec from) to)) ## (= to from) (list from)))] - [i/range Int i/< i/inc i/> i/dec] - [n/range Nat n/< n/inc n/> n/dec] + [i/range Int i/< i/>] + [n/range Nat n/< n/>] ) (def: #export (empty? xs) @@ -362,14 +362,14 @@ (^ (list [_ (#.Nat num-lists)])) (if (n/> +0 num-lists) (let [(^open) Functor<List> - indices (n/range +0 (n/dec num-lists)) + indices (n/range +0 (dec num-lists)) type-vars (: (List Code) (map (|>> nat/encode symbol$) indices)) zip-type (` (All [(~+ type-vars)] (-> (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var))))) type-vars)) (List [(~+ type-vars)])))) vars+lists (|> indices - (map n/inc) + (map inc) (map (function (_ idx) (let [base (nat/encode idx)] [(symbol$ base) @@ -406,7 +406,7 @@ (^ (list [_ (#.Nat num-lists)])) (if (n/> +0 num-lists) (let [(^open) Functor<List> - indices (n/range +0 (n/dec num-lists)) + indices (n/range +0 (dec num-lists)) g!return-type (symbol$ "\treturn-type\t") g!func (symbol$ "\tfunc\t") type-vars (: (List Code) (map (|>> nat/encode symbol$) indices)) @@ -416,7 +416,7 @@ type-vars)) (List (~ g!return-type))))) vars+lists (|> indices - (map n/inc) + (map inc) (map (function (_ idx) (let [base (nat/encode idx)] [(symbol$ base) @@ -509,7 +509,7 @@ #.Nil (#.Cons x xs') - (#.Cons [idx x] (enumerate' (n/inc idx) xs')))) + (#.Cons [idx x] (enumerate' (inc idx) xs')))) (def: #export (enumerate xs) {#.doc "Pairs every element in the list with its index, starting at 0."} @@ -521,4 +521,4 @@ (All [a] (-> Nat (List Nat))) (if (n/= +0 size) (list) - (|> size n/dec (n/range +0)))) + (|> size dec (n/range +0)))) diff --git a/stdlib/source/lux/data/coll/sequence.lux b/stdlib/source/lux/data/coll/sequence.lux index a160a9925..5fe3befae 100644 --- a/stdlib/source/lux/data/coll/sequence.lux +++ b/stdlib/source/lux/data/coll/sequence.lux @@ -52,7 +52,7 @@ (def: branch-idx-mask Nat - (n/dec full-node-size)) + (dec full-node-size)) (def: branch-idx (-> Index Index) @@ -66,7 +66,7 @@ (-> Nat Nat) (if (n/< full-node-size vec-size) +0 - (|> (n/dec vec-size) + (|> (dec vec-size) (bit.logical-right-shift branching-exponent) (bit.left-shift branching-exponent)))) @@ -85,7 +85,7 @@ (def: (push-tail size level tail parent) (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit.logical-right-shift level (n/dec size))) + (let [sub-idx (branch-idx (bit.logical-right-shift level (dec size))) ## If we're currently on a bottom node sub-node (if (n/= branching-exponent level) ## Just add the tail to it @@ -108,7 +108,7 @@ (def: (expand-tail val tail) (All [a] (-> a (Base a) (Base a))) (let [tail-size (array.size tail)] - (|> (array.new (n/inc tail-size)) + (|> (array.new (inc tail-size)) (array.copy tail-size +0 tail +0) (array.write tail-size val)))) @@ -194,7 +194,7 @@ (if (|> vec-size (n/- (tail-off vec-size)) (n/< full-node-size)) ## If so, append to it. (|> vec - (update@ #size n/inc) + (update@ #size inc) (update@ #tail (expand-tail val))) ## Otherwise, push tail into the tree ## -------------------------------------------------------- @@ -216,7 +216,7 @@ (update@ #root (push-tail vec-size (get@ #level vec) (get@ #tail vec))))) ## Finally, update the size of the Sequence and grow a new ## tail with the new element as it's sole member. - (update@ #size n/inc) + (update@ #size inc) (set@ #tail (new-tail val))) ))) @@ -287,9 +287,9 @@ vec-size (if (|> vec-size (n/- (tail-off vec-size)) (n/> +1)) (let [old-tail (get@ #tail vec) - new-tail-size (n/dec (array.size old-tail))] + new-tail-size (dec (array.size old-tail))] (|> vec - (update@ #size n/dec) + (update@ #size dec) (set@ #tail (|> (array.new new-tail-size) (array.copy new-tail-size +0 old-tail +0))))) (maybe.assume @@ -311,7 +311,7 @@ [level root]) [level root])))]] (wrap (|> vec - (update@ #size n/dec) + (update@ #size dec) (set@ #level level') (set@ #root root') (set@ #tail new-tail)))))) diff --git a/stdlib/source/lux/data/coll/stream.lux b/stdlib/source/lux/data/coll/stream.lux index d04b808fb..305a5da4e 100644 --- a/stdlib/source/lux/data/coll/stream.lux +++ b/stdlib/source/lux/data/coll/stream.lux @@ -60,7 +60,7 @@ (All [a] (-> Nat (Stream a) a)) (let [[h t] (continuation.run s)] (if (n/> +0 idx) - (nth (n/dec idx) t) + (nth (dec idx) t) h))) (do-template [<taker> <dropper> <splitter> <pred-type> <pred-test> <pred-step>] @@ -90,7 +90,7 @@ [(list) xs])))] [take-while drop-while split-while (-> a Bool) (pred x) pred] - [take drop split Nat (n/> +0 pred) (n/dec pred)] + [take drop split Nat (n/> +0 pred) (dec pred)] ) (def: #export (unfold step init) diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index dc15c8a6b..8e6254c6b 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -6,17 +6,17 @@ (type abstract))) (def: rgb Nat +256) -(def: top Nat (n/dec rgb)) +(def: top Nat (dec rgb)) -(def: rgb-factor Frac (nat-to-frac top)) +(def: rgb-factor Frac (|> top .int int-to-frac)) (def: scale-down (-> Nat Frac) - (|>> nat-to-frac (f// rgb-factor))) + (|>> .int int-to-frac (f// rgb-factor))) (def: scale-up (-> Frac Nat) - (|>> (f/* rgb-factor) frac-to-nat)) + (|>> (f/* rgb-factor) frac-to-int .nat)) (abstract: #export Color {} {#red Nat @@ -151,7 +151,7 @@ q (|> 1.0 (f/- (f/* f saturation)) (f/* brightness)) t (|> 1.0 (f/- (|> 1.0 (f/- f) (f/* saturation))) (f/* brightness)) v brightness - mod (|> i (f/% 6.0) frac-to-nat) + mod (|> i (f/% 6.0) frac-to-int .nat) red (case mod +0 v +1 q +2 p +3 p +4 t +5 v _ (undefined)) green (case mod +0 t +1 v +2 v +3 q +4 p +5 p _ (undefined)) blue (case mod +0 p +1 p +2 t +3 v +4 v +5 q _ (undefined))] @@ -203,8 +203,10 @@ dE (|> 1.0 (f/- dS)) interpolate' (: (-> Nat Nat Nat) (function (_ end start) - (frac-to-nat (f/+ (f/* dE (nat-to-frac end)) - (f/* dS (nat-to-frac start)))))) + (|> (|> start .int int-to-frac (f/* dS)) + (f/+ (|> end .int int-to-frac (f/* dE))) + frac-to-int + .nat))) [redS greenS blueS] (unpack start) [redE greenE blueE] (unpack end)] (color [(interpolate' redE redS) @@ -283,19 +285,19 @@ (let [[hue saturation luminance] (to-hsl color) slice (normalize slice)] (L/map (function (_ idx) - (from-hsl [(|> idx nat-to-frac (f/* slice) (f/+ hue) normalize) + (from-hsl [(|> idx .int int-to-frac (f/* slice) (f/+ hue) normalize) saturation luminance])) - (list.n/range +0 (n/dec results)))))) + (list.n/range +0 (dec results)))))) (def: #export (monochromatic results color) (-> Nat Color (List Color)) (if (n/= +0 results) (list) (let [[hue saturation brightness] (to-hsb color) - slice (|> 1.0 (f// (nat-to-frac results)))] - (|> (list.n/range +0 (n/dec results)) - (L/map (|>> nat-to-frac + slice (|> 1.0 (f// (|> results .int int-to-frac)))] + (|> (list.n/range +0 (dec results)) + (L/map (|>> .int int-to-frac (f/* slice) (f/+ brightness) normalize diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index 5a203440d..360ef416f 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -40,17 +40,17 @@ (def: #export (rgb color) (-> Color Value) (let [[red green blue] (color.unpack color)] - (format "rgb(" (|> red nat-to-int %i) - "," (|> green nat-to-int %i) - "," (|> blue nat-to-int %i) + (format "rgb(" (|> red .int %i) + "," (|> green .int %i) + "," (|> blue .int %i) ")"))) (def: #export (rgba color alpha) (-> Color Deg Value) (let [[red green blue] (color.unpack color)] - (format "rgba(" (|> red nat-to-int %i) - "," (|> green nat-to-int %i) - "," (|> blue nat-to-int %i) + (format "rgba(" (|> red .int %i) + "," (|> green .int %i) + "," (|> blue .int %i) "," (if (d/= (:: number.Interval<Deg> top) alpha) "1.0" (format "0" (%d alpha))) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index d3c6292cd..ceeb59b1e 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -43,7 +43,7 @@ (#.Some _) (p.codec number.Hex@Codec<Text,Int> (l.many l.hexadecimal)))] - (wrap (|> code int-to-nat text.from-code))) + (wrap (|> code .nat text.from-code))) (p.before (l.this ";")) (p.after (l.this "&#")))) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index eb712d046..bb5cb8b8a 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -91,10 +91,10 @@ (def: succ <succ>) (def: pred <pred>))] - [Nat Order<Nat> n/inc n/dec] - [Int Order<Int> i/inc i/dec] + [Nat Order<Nat> inc dec] + [Int Order<Int> inc dec] [Frac Order<Frac> (f/+ ("lux frac smallest")) (f/- ("lux frac smallest"))] - [Deg Order<Deg> (d/+ (:! Deg +1)) (d/- (:! Deg +1))] + [Deg Order<Deg> inc dec] ) (do-template [<type> <enum> <top> <bottom>] @@ -104,7 +104,7 @@ (def: bottom <bottom>))] [ Nat Enum<Nat> (:! Nat -1) +0] - [ Int Enum<Int> ("lux int max") ("lux int min")] + [ Int Enum<Int> 9_223_372_036_854_775_807 -9_223_372_036_854_775_808] [Frac Enum<Frac> ("lux frac max") ("lux frac min")] [ Deg Enum<Deg> (:! Deg -1) (:! Deg +0)] ) @@ -173,7 +173,7 @@ ## [Values & Syntax] (def: (get-char full idx) (-> Text Nat (Maybe Text)) - ("lux text clip" full idx (n/inc idx))) + ("lux text clip" full idx (inc idx))) (def: (binary-character value) (-> Nat (Maybe Text)) @@ -313,7 +313,7 @@ (#e.Error ("lux text concat" <error> repr)) (#.Some digit-value) - (recur (n/inc idx) + (recur (inc idx) (|> output (n/* <base>) (n/+ digit-value))))) (#e.Success output))) @@ -336,12 +336,12 @@ "-" "")] (loop [input (|> value (i// <base>) (:: Number<Int> abs)) - output (|> value (i/% <base>) (:: Number<Int> abs) int-to-nat + output (|> value (i/% <base>) (:: Number<Int> abs) .nat <to-character> maybe.assume)] (if (i/= 0 input) ("lux text concat" sign output) - (let [digit (maybe.assume (<to-character> (int-to-nat (i/% <base> input))))] + (let [digit (maybe.assume (<to-character> (.nat (i/% <base> input))))] (recur (i// <base> input) ("lux text concat" digit output)))))))) @@ -363,7 +363,7 @@ (#e.Error <error>) (#.Some digit-value) - (recur (n/inc idx) + (recur (inc idx) (|> output (i/* <base>) (i/+ (:! Int digit-value)))))) (#e.Success (i/* sign output))))) (#e.Error <error>)))))] @@ -388,7 +388,7 @@ output ""] (if (n/= +0 zeroes-left) output - (recur (n/dec zeroes-left) + (recur (dec zeroes-left) ("lux text concat" "0" output)))) padded-output ("lux text concat" zero-padding raw-output)] ("lux text concat" "." padded-output))) @@ -424,7 +424,7 @@ (if (f/= 0.0 dec-left) ("lux text concat" "." output) (let [shifted (f/* <base> dec-left) - digit (|> shifted (f/% <base>) frac-to-int int-to-nat + digit (|> shifted (f/% <base>) frac-to-int .nat (get-char <char-set>) maybe.assume)] (recur (f/% 1.0 shifted) ("lux text concat" output digit))))))] @@ -434,7 +434,7 @@ (case ("lux text index" repr "." +0) (#.Some split-index) (let [whole-part (maybe.assume ("lux text clip" repr +0 split-index)) - decimal-part (maybe.assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr)))] + decimal-part (maybe.assume ("lux text clip" repr (inc split-index) ("lux text size" repr)))] (case [(:: <int> decode whole-part) (:: <int> decode decimal-part)] (^multi [(#e.Success whole) (#e.Success decimal)] @@ -446,7 +446,7 @@ output 1.0] (if (n/= +0 muls-left) output - (recur (n/dec muls-left) + (recur (dec muls-left) (f/* <base> output)))) adjusted-decimal (|> decimal int-to-frac (f// div-power)) dec-deg (case (:: Hex@Codec<Text,Deg> decode ("lux text concat" "." decimal-part)) @@ -581,7 +581,7 @@ output ""] (if (n/= +0 zeroes-left) output - (recur (n/dec zeroes-left) + (recur (dec zeroes-left) ("lux text concat" "0" output)))))) padded-input (if on-left? ("lux text concat" zero-padding input) @@ -610,7 +610,7 @@ whole-part (maybe.assume ("lux text clip" raw-bin (if (f/= -1.0 sign) +1 +0) dot-idx)) - decimal-part (maybe.assume ("lux text clip" raw-bin (n/inc dot-idx) ("lux text size" raw-bin))) + decimal-part (maybe.assume ("lux text clip" raw-bin (inc dot-idx) ("lux text size" raw-bin))) hex-output (|> (<from> false decimal-part) ("lux text concat" ".") ("lux text concat" (<from> true whole-part)) @@ -627,7 +627,7 @@ (case ("lux text index" repr "." +0) (#.Some split-index) (let [whole-part (maybe.assume ("lux text clip" repr (if (f/= -1.0 sign) +1 +0) split-index)) - decimal-part (maybe.assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr))) + decimal-part (maybe.assume ("lux text clip" repr (inc split-index) ("lux text size" repr))) as-binary (|> (<to> decimal-part) ("lux text concat" ".") ("lux text concat" (<to> whole-part)) @@ -755,7 +755,7 @@ (let [raw (|> (digits-get idx output) (n/* +5) (n/+ carry))] - (recur (n/dec idx) + (recur (dec idx) (n// +10 raw) (digits-put idx (n/% +10 raw) output))) output))) @@ -766,21 +766,21 @@ output (|> (make-digits []) (digits-put power +1))] (if (i/>= 0 (:! Int times)) - (recur (n/dec times) + (recur (dec times) (digits-times-5! power output)) output))) (def: (digits-to-text digits) (-> Digits Text) - (loop [idx (n/dec bit.width) + (loop [idx (dec bit.width) all-zeroes? true output ""] (if (i/>= 0 (:! Int idx)) (let [digit (digits-get idx digits)] (if (and (n/= +0 digit) all-zeroes?) - (recur (n/dec idx) true output) - (recur (n/dec idx) + (recur (dec idx) true output) + (recur (dec idx) false ("lux text concat" (:: Codec<Text,Int> encode (:! Int digit)) @@ -791,7 +791,7 @@ (def: (digits-add param subject) (-> Digits Digits Digits) - (loop [idx (n/dec bit.width) + (loop [idx (dec bit.width) carry +0 output (make-digits [])] (if (i/>= 0 (:! Int idx)) @@ -799,7 +799,7 @@ carry (digits-get idx param) (digits-get idx subject))] - (recur (n/dec idx) + (recur (dec idx) (n// +10 raw) (digits-put idx (n/% +10 raw) output))) output))) @@ -817,7 +817,7 @@ #.None (#.Some digit) - (recur (n/inc idx) + (recur (inc idx) (digits-put idx digit output)))) (#.Some output))) #.None))) @@ -829,7 +829,7 @@ (let [pd (digits-get idx param) sd (digits-get idx subject)] (if (n/= pd sd) - (recur (n/inc idx)) + (recur (inc idx)) (n/< pd sd)))))) (def: (digits-sub-once! idx param subject) @@ -842,21 +842,21 @@ (n/- param))] (|> subject (digits-put idx diff) - (digits-sub-once! (n/dec idx) +1)))))) + (digits-sub-once! (dec idx) +1)))))) (def: (digits-sub! param subject) (-> Digits Digits Digits) - (loop [idx (n/dec bit.width) + (loop [idx (dec bit.width) output subject] - (if (i/>= 0 (nat-to-int idx)) - (recur (n/dec idx) + (if (i/>= 0 (.int idx)) + (recur (dec idx) (digits-sub-once! idx (digits-get idx param) output)) output))) (struct: #export _ (Codec Text Deg) (def: (encode input) (let [input (:! Nat input) - last-idx (n/dec bit.width)] + last-idx (dec bit.width)] (if (n/= +0 input) ".0" (loop [idx last-idx @@ -865,9 +865,9 @@ (if (bit.set? idx input) (let [digits' (digits-add (digits-power (n/- idx last-idx)) digits)] - (recur (n/dec idx) + (recur (dec idx) digits')) - (recur (n/dec idx) + (recur (dec idx) digits)) ("lux text concat" "." (digits-to-text digits)) ))))) @@ -881,7 +881,7 @@ _ false)] (if (and dotted? - (n/<= (n/inc bit.width) length)) + (n/<= (inc bit.width) length)) (case (|> ("lux text clip" input +1 length) maybe.assume text-to-digits) @@ -893,10 +893,10 @@ (let [power (digits-power idx)] (if (digits-lt power digits) ## Skip power - (recur digits (n/inc idx) output) + (recur digits (inc idx) output) (recur (digits-sub! power digits) - (n/inc idx) - (bit.set (n/- idx (n/dec bit.width)) output)))) + (inc idx) + (bit.set (n/- idx (dec bit.width)) output)))) (#e.Success (:! Deg output)))) #.None @@ -915,48 +915,48 @@ (def: exponent-size Nat +11) (def: #export (frac-to-bits input) - (-> Frac Nat) - (cond (not-a-number? input) - (hex "+7FF7FFFFFFFFFFFF") - - (f/= positive-infinity input) - (hex "+7FF0000000000000") - - (f/= negative-infinity input) - (hex "+FFF0000000000000") - - (f/= 0.0 input) - (let [reciprocal (f// input 1.0)] - (if (f/= positive-infinity reciprocal) - ## Positive zero - (hex "+0000000000000000") - ## Negative zero - (hex "+8000000000000000"))) - - ## else - (let [sign (:: Number<Frac> signum input) - input (:: Number<Frac> abs input) - exponent ("lux math floor" (log2 input)) - exponent-mask (|> +1 (bit.left-shift exponent-size) n/dec) - mantissa (|> input - ## Normalize - (f// ("lux math pow" 2.0 exponent)) - ## Make it int-equivalent - (f/* ("lux math pow" 2.0 52.0))) - sign-bit (if (f/= -1.0 sign) +1 +0) - exponent-bits (|> exponent frac-to-int int-to-nat (n/+ double-bias) (bit.and exponent-mask)) - mantissa-bits (|> mantissa frac-to-int int-to-nat)] - ($_ bit.or - (bit.left-shift +63 sign-bit) - (bit.left-shift mantissa-size exponent-bits) - (bit.clear mantissa-size mantissa-bits))) - )) + (-> Frac I64) + (i64 (cond (not-a-number? input) + (hex "+7FF7FFFFFFFFFFFF") + + (f/= positive-infinity input) + (hex "+7FF0000000000000") + + (f/= negative-infinity input) + (hex "+FFF0000000000000") + + (f/= 0.0 input) + (let [reciprocal (f// input 1.0)] + (if (f/= positive-infinity reciprocal) + ## Positive zero + (hex "+0000000000000000") + ## Negative zero + (hex "+8000000000000000"))) + + ## else + (let [sign (:: Number<Frac> signum input) + input (:: Number<Frac> abs input) + exponent ("lux math floor" (log2 input)) + exponent-mask (|> +1 (bit.left-shift exponent-size) dec) + mantissa (|> input + ## Normalize + (f// ("lux math pow" 2.0 exponent)) + ## Make it int-equivalent + (f/* ("lux math pow" 2.0 52.0))) + sign-bit (if (f/= -1.0 sign) +1 +0) + exponent-bits (|> exponent frac-to-int .nat (n/+ double-bias) (bit.and exponent-mask)) + mantissa-bits (|> mantissa frac-to-int .nat)] + ($_ bit.or + (bit.left-shift +63 sign-bit) + (bit.left-shift mantissa-size exponent-bits) + (bit.clear mantissa-size mantissa-bits))) + ))) (do-template [<getter> <mask> <size> <offset>] - [(def: <mask> (|> +1 (bit.left-shift <size>) n/dec (bit.left-shift <offset>))) + [(def: <mask> (|> +1 (bit.left-shift <size>) dec (bit.left-shift <offset>))) (def: (<getter> input) - (-> Nat Nat) - (|> input (bit.and <mask>) (bit.logical-right-shift <offset>)))] + (-> (I64 Top) I64) + (|> input (bit.and <mask>) (bit.logical-right-shift <offset>) i64))] [mantissa mantissa-mask mantissa-size +0] [exponent exponent-mask exponent-size mantissa-size] @@ -964,7 +964,7 @@ ) (def: #export (bits-to-frac input) - (-> Nat Frac) + (-> (I64 Top) Frac) (let [S (sign input) E (exponent input) M (mantissa input)] @@ -982,10 +982,10 @@ ## else (let [normalized (|> M (bit.set mantissa-size) - nat-to-int int-to-frac + .int int-to-frac (f// ("lux math pow" 2.0 52.0))) power (|> E (n/- double-bias) - nat-to-int int-to-frac + .int int-to-frac ("lux math pow" 2.0)) shifted (f/* power normalized)] @@ -1000,7 +1000,7 @@ (struct: #export _ (Hash Int) (def: eq Eq<Int>) - (def: hash int-to-nat)) + (def: hash .nat)) (struct: #export _ (Hash Frac) (def: eq Eq<Frac>) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 7d4fcbfbf..879ee0c1e 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -286,17 +286,17 @@ (-> Complex Frac) (math.atan2 real imaginary)) -(def: #export (nth-roots nth input) +(def: #export (roots nth input) (-> Nat Complex (List Complex)) (if (n/= +0 nth) (list) - (let [r-nth (|> nth nat-to-int int-to-frac) + (let [r-nth (|> nth .int int-to-frac) nth-root-of-abs (|> input c/abs (get@ #real) (math.pow (f// r-nth 1.0))) nth-phi (|> input argument (f// r-nth)) slice (|> math.pi (f/* 2.0) (f// r-nth))] - (|> (list.n/range +0 (n/dec nth)) + (|> (list.n/range +0 (dec nth)) (L/map (function (_ nth') - (let [inner (|> nth' nat-to-int int-to-frac + (let [inner (|> nth' .int int-to-frac (f/* slice) (f/+ nth-phi)) real (f/* nth-root-of-abs diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 1a9aa112b..9dbf0dec5 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -49,7 +49,7 @@ (def: (last-index-of'' part since text) (-> Text Nat Text (Maybe Nat)) - (case ("lux text index" text part (n/inc since)) + (case ("lux text index" text part (inc since)) #.None (#.Some since) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 980926b90..d965020e0 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -44,7 +44,7 @@ (function (_ [offset tape]) (case (text.nth offset tape) (#.Some output) - (#e.Success [[(n/inc offset) tape] (text.from-code output)]) + (#e.Success [[(inc offset) tape] (text.from-code output)]) _ (#e.Error cannot-lex-error)) @@ -166,7 +166,7 @@ (#.Some output) (let [output (text.from-code output)] (if (text.contains? output options) - (#e.Success [[(n/inc offset) tape] output]) + (#e.Success [[(inc offset) tape] output]) (#e.Error ($_ text/compose "Character (" output ") is not one of: " options)))) _ @@ -180,7 +180,7 @@ (#.Some output) (let [output (text.from-code output)] (if (.not (text.contains? output options)) - (#e.Success [[(n/inc offset) tape] output]) + (#e.Success [[(inc offset) tape] output]) (#e.Error ($_ text/compose "Character (" output ") is one of: " options)))) _ @@ -193,7 +193,7 @@ (case (text.nth offset tape) (#.Some output) (if (p output) - (#e.Success [[(n/inc offset) tape] (text.from-code output)]) + (#e.Success [[(inc offset) tape] (text.from-code output)]) (#e.Error ($_ text/compose "Character does not satisfy predicate: " (text.from-code output)))) _ diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 4bdc6d3c0..f644c4669 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -181,14 +181,14 @@ (l.Lexer Nat) (|> (l.many l.decimal) (p.codec number.Codec<Text,Int>) - (p/map int-to-nat))) + (p/map .nat))) (def: re-back-reference^ (l.Lexer Code) (p.either (do p.Monad<Parser> [_ (l.this "\\") id number^] - (wrap (` ((~! ..copy) (~ (code.symbol ["" (int/encode (nat-to-int id))])))))) + (wrap (` ((~! ..copy) (~ (code.symbol ["" (int/encode (.int id))])))))) (do p.Monad<Parser> [_ (l.this "\\k<") captured-name identifier-part^ @@ -285,7 +285,7 @@ [idx (code.symbol ["" _name])] #.None - [(i/inc idx) (code.symbol ["" (int/encode idx)])]) + [(inc idx) (code.symbol ["" (int/encode idx)])]) access (if (n/> +0 num-captures) (` (product.left (~ name!))) name!)] diff --git a/stdlib/source/lux/lang/syntax.lux b/stdlib/source/lux/lang/syntax.lux index 6c7236f76..bc1543cac 100644 --- a/stdlib/source/lux/lang/syntax.lux +++ b/stdlib/source/lux/lang/syntax.lux @@ -25,7 +25,7 @@ ## (file-name, line, column) to keep track of their provenance and ## location, which is helpful for documentation and debugging. (.module: - lux + [lux #- nat int deg] (lux (control monad ["p" parser "p/" Monad<Parser>] ["ex" exception #+ exception:]) @@ -74,7 +74,7 @@ comment (l.some (l.none-of new-line)) _ (l.this new-line)] (wrap [(|> where - (update@ #.line n/inc) + (update@ #.line inc) (set@ #.column +0)) comment]))) @@ -111,7 +111,7 @@ [_ (l.this new-line)] (recur (format comment new-line) (|> where - (update@ #.line n/inc) + (update@ #.line inc) (set@ #.column +0)))) ## This is the rule for handling nested sub-comments. ## Ultimately, the whole comment is just treated as text @@ -238,7 +238,7 @@ (do @ [normal (l.none-of "\\\"\n")] (wrap [(|> where - (update@ #.column n/inc)) + (update@ #.column inc)) normal])) ## Must handle escaped ## chars separately. @@ -250,7 +250,7 @@ _ (l.this "\"") #let [char (maybe.assume (text.nth +0 char))]] (wrap [(|> where' - (update@ #.column n/inc)) + (update@ #.column inc)) [where (#.Nat char)]]))) (def: (normal-nat where) @@ -341,7 +341,7 @@ ## as many spaces as necessary to be column-aligned. ## This helps ensure that the formatting on the text in the ## source-code matches the formatting of the Text value. - #let [offset-column (n/inc (get@ #.column where))] + #let [offset-column (inc (get@ #.column where))] [where' text-read] (: (l.Lexer [Cursor Text]) ## I must keep track of how much of the ## text body has been read, how far the @@ -350,7 +350,7 @@ ## processing normal text body. (loop [text-read "" where (|> where - (update@ #.column n/inc)) + (update@ #.column inc)) must-have-offset? false] (p.either (if must-have-offset? ## If I'm at the start of a @@ -375,8 +375,8 @@ (update@ #.column (n/+ offset-size))) false) (p.fail (format "Each line of a multi-line text must have an appropriate offset!\n" - "Expected: " (%i (nat-to-int offset-column)) " columns.\n" - " Actual: " (%i (nat-to-int offset-size)) " columns.\n")))) + "Expected: " (%i (.int offset-column)) " columns.\n" + " Actual: " (%i (.int offset-size)) " columns.\n")))) ($_ p.either ## Normal text characters. (do @ @@ -397,7 +397,7 @@ ## reaches the right-delimiter. (do @ [_ (l.this "\"")] - (wrap [(update@ #.column n/inc where) + (wrap [(update@ #.column inc where) text-read])))) ## If a new-line is ## encountered, it gets @@ -408,7 +408,7 @@ [_ (l.this new-line)] (recur (format text-read new-line) (|> where - (update@ #.line n/inc) + (update@ #.line inc) (set@ #.column +0)) true)))))] (wrap [where' @@ -439,7 +439,7 @@ ## end-delimiter. where' (left-padding^ where) _ (l.this <close>)] - (wrap [(update@ #.column n/inc where') + (wrap [(update@ #.column inc where') (sequence.to-list elems)]))))] (wrap [where' [where (<tag> elems)]])))] @@ -474,7 +474,7 @@ (do @ [where' (left-padding^ where) _ (l.this "}")] - (wrap [(update@ #.column n/inc where') + (wrap [(update@ #.column inc where') (sequence.to-list elems)]))))] (wrap [where' [where (#.Record elems)]]))) @@ -537,7 +537,7 @@ [_ (l.this identifier-separator) def-name ident-part^] (wrap [["lux" def-name] - (n/inc (text.size def-name))])) + (inc (text.size def-name))])) ## Not all identifiers must be specified with a module part. ## If that part is not provided, the identifier will be created ## with the empty "" text as the module. diff --git a/stdlib/source/lux/lang/type.lux b/stdlib/source/lux/lang/type.lux index 48db0b928..d7dc33ca9 100644 --- a/stdlib/source/lux/lang/type.lux +++ b/stdlib/source/lux/lang/type.lux @@ -92,7 +92,7 @@ type type] (case type (<tag> env sub-type) - (recur (n/inc num-args) sub-type) + (recur (inc num-args) sub-type) _ [num-args type])))] @@ -301,7 +301,7 @@ (-> Nat Type Type) (case size +0 body - _ (<tag> (list) (<name> (n/dec size) body))))] + _ (|> body (<name> (dec size)) (<tag> (list)))))] [univ-q #.UnivQ] [ex-q #.ExQ] @@ -329,4 +329,4 @@ (-> Nat Type Type) (case level +0 elem-type - _ (#.Primitive "#Array" (list (array (n/dec level) elem-type))))) + _ (|> elem-type (array (dec level)) (list) (#.Primitive "#Array")))) diff --git a/stdlib/source/lux/lang/type/check.lux b/stdlib/source/lux/lang/type/check.lux index 1853f0931..4537ae38d 100644 --- a/stdlib/source/lux/lang/type/check.lux +++ b/stdlib/source/lux/lang/type/check.lux @@ -114,6 +114,10 @@ (var::get id plist')) )) +(def: (var::new id plist) + (-> Var Type-Vars Type-Vars) + (#.Cons [id #.None] plist)) + (def: (var::put id value plist) (-> Var (Maybe Type) Type-Vars Type-Vars) (case plist @@ -163,7 +167,7 @@ (Check [Nat Type]) (function (_ context) (let [id (get@ #.ex-counter context)] - (#e.Success [(update@ #.ex-counter n/inc context) + (#e.Success [(update@ #.ex-counter inc context) [id (#.Ex id)]])))) (do-template [<name> <outputT> <fail> <succeed>] @@ -228,8 +232,8 @@ (function (_ context) (let [id (get@ #.var-counter context)] (#e.Success [(|> context - (update@ #.var-counter n/inc) - (update@ #.var-bindings (var::put id #.None))) + (update@ #.var-counter inc) + (update@ #.var-bindings (var::new id))) [id (#.Var id)]])))) (def: get-bindings diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 1328fc034..8131db902 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -363,8 +363,12 @@ A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."} (-> Text (Meta Code)) (function (_ compiler) - (#e.Success [(update@ #.seed n/inc compiler) - (code.symbol ["" ($_ text/compose "__gensym__" prefix (:: number.Codec<Text,Nat> encode (get@ #.seed compiler)))])]))) + (#e.Success [(update@ #.seed inc compiler) + (|> compiler + (get@ #.seed) + (:: number.Codec<Text,Nat> encode) + ($_ text/compose "__gensym__" prefix) + [""] code.symbol)]))) (def: (get-local-symbol ast) (-> Code (Meta Text)) diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index 10bfed3ef..44cd21b6d 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -1,5 +1,5 @@ (.module: - lux + [lux #- nat int deg] (lux (control [eq #+ Eq]) (data bool number diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 54a856463..4d9d6cf12 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -151,19 +151,19 @@ all-varsL (: (List Code) (list))] (if (n/< num-args current-arg) (if (n/= +0 current-arg) - (let [varL (label (n/inc funcI))] - (recur (n/inc current-arg) + (let [varL (label (inc funcI))] + (recur (inc current-arg) (|> env' (dict.put funcI [headT funcL]) - (dict.put (n/inc funcI) [(#.Bound (n/inc funcI)) varL])) + (dict.put (inc funcI) [(#.Bound (inc funcI)) varL])) (#.Cons varL all-varsL))) (let [partialI (|> current-arg (n/* +2) (n/+ funcI)) - partial-varI (n/inc partialI) + partial-varI (inc partialI) partial-varL (label partial-varI) - partialC (` ((~ funcL) (~+ (|> (list.n/range +0 (n/dec num-args)) - (list/map (|>> (n/* +2) n/inc (n/+ funcI) label)) + partialC (` ((~ funcL) (~+ (|> (list.n/range +0 (dec num-args)) + (list/map (|>> (n/* +2) inc (n/+ funcI) label)) list.reverse))))] - (recur (n/inc current-arg) + (recur (inc current-arg) (|> env' (dict.put partialI [.Bottom partialC]) (dict.put partial-varI [(#.Bound partial-varI) partial-varL])) @@ -215,7 +215,7 @@ (let [env-level (n// +2 (dict.size env)) bound-level (n// +2 idx) bound-idx (n/% +2 idx)] - (|> env-level n/dec (n/- bound-level) (n/* +2) (n/+ bound-idx)))) + (|> env-level dec (n/- bound-level) (n/* +2) (n/+ bound-idx)))) (def: #export bound (Poly Code) @@ -402,7 +402,7 @@ (let [idx (adjusted-idx env idx)] (if (n/= +0 idx) (|> (dict.get idx env) maybe.assume product.left (to-code env)) - (` (.$ (~ (code.nat (n/dec idx))))))) + (` (.$ (~ (code.nat (dec idx))))))) (#.Apply (#.Named ["lux" "Bottom"] _) (#.Bound idx)) (let [idx (adjusted-idx env idx)] diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index ec120e0e1..7d3083660 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -112,7 +112,7 @@ (do @ [g!eqs (poly.tuple (p.many Eq<?>)) #let [g!_ (code.local-symbol "_____________") - indices (|> (list.size g!eqs) n/dec (list.n/range +0)) + indices (|> (list.size g!eqs) dec (list.n/range +0)) g!lefts (list/map (|>> nat/encode (text/compose "left") code.local-symbol) indices) g!rights (list/map (|>> nat/encode (text/compose "right") code.local-symbol) indices)]] (wrap (` (: (~ (@Eq inputT)) diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux index 91a325198..525b292c7 100644 --- a/stdlib/source/lux/macro/poly/functor.lux +++ b/stdlib/source/lux/macro/poly/functor.lux @@ -29,7 +29,7 @@ (function (_ unwrappedT) (if (n/= +1 num-vars) (` (functor.Functor (~ (poly.to-code *env* unwrappedT)))) - (let [paramsC (|> num-vars n/dec list.indices (L/map (|>> %n code.local-symbol)))] + (let [paramsC (|> num-vars dec list.indices (L/map (|>> %n code.local-symbol)))] (` (All [(~+ paramsC)] (functor.Functor ((~ (poly.to-code *env* unwrappedT)) (~+ paramsC))))))))) Arg<?> (: (-> Code (poly.Poly Code)) @@ -37,7 +37,7 @@ ($_ p.either ## Type-var (do p.Monad<Parser> - [#let [varI (|> num-vars (n/* +2) n/dec)] + [#let [varI (|> num-vars (n/* +2) dec)] _ (poly.var varI)] (wrap (` ((~ funcC) (~ valueC))))) ## Variants @@ -59,7 +59,7 @@ (do @ [_ (wrap []) memberC (Arg<?> slotC)] - (recur (n/inc idx) + (recur (inc idx) (L/compose pairsCC (list [slotC memberC]))))) (wrap pairsCC)))))] (wrap (` (case (~ valueC) @@ -72,7 +72,7 @@ outL (code.local-symbol "____________outL")] [inT+ outC] (poly.function (p.many poly.any) (Arg<?> outL)) - #let [inC+ (|> (list.size inT+) n/dec + #let [inC+ (|> (list.size inT+) dec (list.n/range +0) (L/map (|>> %n (format "____________inC") code.local-symbol)))]] (wrap (` (function ((~ g!) (~+ inC+)) diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 44075647d..51a996c4c 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -31,7 +31,7 @@ (def: tag (-> Nat Frac) - (|>> nat-to-int int-to-frac)) + (|>> .int int-to-frac)) (def: (rec-encode non-rec) (All [a] (-> (-> (-> a JSON) @@ -40,28 +40,28 @@ (function (_ input) (non-rec (rec-encode non-rec) input))) -(def: low-mask Nat (|> +1 (bit.left-shift +32) n/dec)) +(def: low-mask Nat (|> +1 (bit.left-shift +32) dec)) (def: high-mask Nat (|> low-mask (bit.left-shift +32))) (struct: _ (Codec JSON Nat) (def: (encode input) (let [high (|> input (bit.and high-mask) (bit.logical-right-shift +32)) low (bit.and low-mask input)] - (#//.Array (sequence (|> high nat-to-int int-to-frac #//.Number) - (|> low nat-to-int int-to-frac #//.Number))))) + (#//.Array (sequence (|> high .int int-to-frac #//.Number) + (|> low .int int-to-frac #//.Number))))) (def: (decode input) (<| (//.run input) //.array (do p.Monad<Parser> [high //.number low //.number]) - (wrap (n/+ (|> high frac-to-int int-to-nat (bit.left-shift +32)) - (|> low frac-to-int int-to-nat)))))) + (wrap (n/+ (|> high frac-to-int .nat (bit.left-shift +32)) + (|> low frac-to-int .nat)))))) (struct: _ (Codec JSON Int) - (def: encode (|>> int-to-nat (:: Codec<JSON,Nat> encode))) + (def: encode (|>> .nat (:: Codec<JSON,Nat> encode))) (def: decode - (|>> (:: Codec<JSON,Nat> decode) (:: e.Functor<Error> map nat-to-int)))) + (|>> (:: Codec<JSON,Nat> decode) (:: e.Functor<Error> map .int)))) (def: (nullable writer) {#.doc "Builds a JSON generator for potentially inexistent values."} @@ -159,7 +159,7 @@ (do @ [g!encoders (poly.tuple (p.many Codec<JSON,?>//encode)) #let [g!_ (code.local-symbol "_______") - g!members (|> (list.size g!encoders) n/dec + g!members (|> (list.size g!encoders) dec (list.n/range +0) (list/map (|>> nat/encode code.local-symbol)))]] (wrap (` (: (~ (@JSON//encode inputT)) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 0907d3d81..5f5c17e20 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -1,5 +1,5 @@ (.module: - lux + [lux #- nat int deg] (lux [macro #+ with-gensyms] (control [monad #+ do Monad] [eq #+ Eq] diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 25cf120a3..5994a3c22 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -89,7 +89,7 @@ n n] (if (n/<= +1 n) acc - (recur (n/* n acc) (n/dec n))))) + (recur (n/* n acc) (dec n))))) (def: #export (hypotenuse catA catB) (-> Frac Frac Frac) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index e90c3eb6d..484574c82 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -1,5 +1,5 @@ (.module: {#.doc "Pseudo-random number generation (PRNG) algorithms."} - [lux #- list] + [lux #- list i64 nat int deg] (lux (control [functor #+ Functor] [apply #+ Apply] [monad #+ do Monad] @@ -22,7 +22,7 @@ (type: #export #rec PRNG {#.doc "An abstract way to represent any PRNG."} - (-> Top [PRNG Nat])) + (-> Top [PRNG I64])) (type: #export (Random a) {#.doc "A producer of random values based on a PRNG."} @@ -64,37 +64,36 @@ (wrap sample) (filter pred gen)))) -(def: #export nat - (Random Nat) - (function (_ prng) - (let [[prng left] (prng []) - [prng right] (prng [])] - [prng (n/+ (bit.left-shift +32 left) - right)]))) - -(def: #export int - (Random Int) - (:: Monad<Random> map nat-to-int nat)) - (def: #export bool (Random Bool) (function (_ prng) (let [[prng output] (prng [])] [prng (|> output (bit.and +1) (n/= +1))]))) -(def: (bits n) - (-> Nat (Random Nat)) +(def: #export i64 + (Random I64) (function (_ prng) - (let [[prng output] (prng [])] - [prng (bit.logical-right-shift (n/- n +64) output)]))) + (let [[prng left] (prng []) + [prng right] (prng [])] + [prng (|> left + (bit.left-shift +32) + ("lux i64 +" right))]))) -(def: #export frac - (Random Frac) - (:: Monad<Random> map number.bits-to-frac nat)) +(def: #export nat + (Random Nat) + (:: Monad<Random> map .nat ..i64)) + +(def: #export int + (Random Int) + (:: Monad<Random> map .int ..i64)) (def: #export deg (Random Deg) - (:: Monad<Random> map (|>> (:! Deg)) nat)) + (:: Monad<Random> map .deg ..i64)) + +(def: #export frac + (Random Frac) + (:: Monad<Random> map number.bits-to-frac nat)) (def: #export (text' char-gen size) (-> (Random Nat) Nat (Random Text)) @@ -102,18 +101,18 @@ (:: Monad<Random> wrap "") (do Monad<Random> [x char-gen - xs (text' char-gen (n/dec size))] + xs (text' char-gen (dec size))] (wrap (text/compose (text.from-code x) xs))))) -(type: Char-Range [Nat Nat]) +(type: Region [Nat Nat]) (do-template [<name> <from> <to>] - [(def: <name> Char-Range [(hex <from>) (hex <to>)])] + [(def: <name> Region [(hex <from>) (hex <to>)])] - [Thaana "+0780" "+07BF"] - [Khmer-Symbols "+19E0" "+19FF"] + [Thaana "+0780" "+07BF"] + [Khmer-Symbols "+19E0" "+19FF"] [Phonetic-Extensions "+1D00" "+1D7F"] - [Hangul-Syllables "+AC00" "+D7AF"] + [Hangul-Syllables "+AC00" "+D7AF"] [Cypriot-Syllabary "+10800" "+1083F"] [Tai-Xuan-Jing-Symbols "+1D300" "+1D35F"] @@ -123,10 +122,11 @@ ) (def: (within? [from to] char) - (-> Char-Range Nat Bool) - (and (n/>= from char) (n/<= to char))) + (-> Region Nat Bool) + (and (n/>= from char) + (n/<= to char))) -(def: unicode-ceiling (n/inc (product.right CJK-Compatibility-Ideographs-Supplement))) +(def: unicode-ceiling (|> CJK-Compatibility-Ideographs-Supplement product.right inc)) (def: #export unicode (Random Nat) @@ -254,7 +254,7 @@ (if (n/> +0 size) (do Monad<Random> [x value-gen - xs (<name> (n/dec size) value-gen)] + xs (<name> (dec size) value-gen)] (wrap (<plus> x xs))) (:: Monad<Random> wrap <zero>)))] @@ -278,7 +278,7 @@ (All [a] (-> (Hash a) Nat (Random a) (Random (Set a)))) (if (n/> +0 size) (do Monad<Random> - [xs (set Hash<a> (n/dec size) value-gen)] + [xs (set Hash<a> (dec size) value-gen)] (loop [_ []] (do @ [x value-gen @@ -292,7 +292,7 @@ (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dict k v)))) (if (n/> +0 size) (do Monad<Random> - [kv (dict Hash<a> (n/dec size) key-gen value-gen)] + [kv (dict Hash<a> (dec size) key-gen value-gen)] (loop [_ []] (do @ [k key-gen @@ -313,28 +313,30 @@ {#.doc "An implementation of the PCG32 algorithm. For more information, please see: http://www.pcg-random.org/"} - (-> [Nat Nat] PRNG) + (-> [(I64 Top) (I64 Top)] PRNG) (function (_ _) - (let [seed' (|> seed (n/* pcg-32-magic-mult) (n/+ inc)) - xor-shifted (|> seed (bit.logical-right-shift +18) (bit.xor seed) (bit.logical-right-shift +27)) - rot (|> seed (bit.logical-right-shift +59))] - [(pcg-32 [inc seed']) (bit.rotate-right rot xor-shifted)] - ))) + [(|> seed .nat (n/* pcg-32-magic-mult) ("lux i64 +" inc) [inc] pcg-32) + (let [rot (|> seed .i64 (bit.logical-right-shift +59))] + (|> seed + (bit.logical-right-shift +18) + (bit.xor seed) + (bit.logical-right-shift +27) + (bit.rotate-right rot) + .i64))])) (def: #export (xoroshiro-128+ [s0 s1]) {#.doc "An implementation of the Xoroshiro128+ algorithm. For more information, please see: http://xoroshiro.di.unimi.it/"} - (-> [Nat Nat] PRNG) + (-> [(I64 Top) (I64 Top)] PRNG) (function (_ _) - (let [result (n/+ s0 s1) - s01 (bit.xor s0 s1) - s0' (|> (bit.rotate-left +55 s0) - (bit.xor s01) - (bit.xor (bit.left-shift +14 s01))) - s1' (bit.rotate-left +36 s01)] - [(xoroshiro-128+ [s0' s1']) result]) - )) + [(let [s01 (bit.xor s0 s1)] + (xoroshiro-128+ [(|> s0 + (bit.rotate-left +55) + (bit.xor s01) + (bit.xor (bit.left-shift +14 s01))) + (bit.rotate-left +36 s01)])) + ("lux i64 +" s0 s1)])) (def: (swap from to vec) (All [a] (-> Nat Nat (Sequence a) (Sequence a))) @@ -352,7 +354,7 @@ [rand nat] (wrap (swap idx (n/% _size rand) vec)))) sequence - (list.n/range +0 (n/dec _size)))] + (list.n/range +0 (dec _size)))] (|> _shuffle (run (pcg-32 [+123 seed])) product.right))) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 7162d8e4f..c78424559 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -17,22 +17,12 @@ [duration]) ["r" math/random])) -## [Host] -(do-template [<name> <signal>] - [(def: <name> - (IO Bottom) - (io.exit <signal>))] - - [exit 0] - [die 1] - ) - ## [Types] (type: #export Counters [Nat Nat]) (type: #export Seed {#.doc "The seed value used for random testing (if that feature is used)."} - Nat) + (I64 Top)) (type: #export Test (r.Random (Promise [Counters Text]))) @@ -74,10 +64,10 @@ (list/map (: (-> [Text (IO Test) Text] (Promise Counters)) (function (_ [module test description]) (do @ - [#let [pre (io.run instant.now) - seed (int-to-nat (instant.to-millis pre))] + [#let [pre (io.run instant.now)] [counters documentation] (|> (io.run test) - (r.run (r.pcg-32 [pcg-32-magic-inc seed])) + (r.run (r.pcg-32 [pcg-32-magic-inc + (instant.to-millis pre)])) product.right) #let [post (io.run instant.now) _ (log! (format "@ " module " " @@ -100,6 +90,11 @@ test)] [prng result]))) +(def: (times-failure seed documentation) + (-> (I64 Top) Text Text) + (format "Failed with this seed: " (%n (.nat seed)) "\n" + documentation)) + (def: #export (times amount test) (-> Nat Test Test) (cond (n/= +0 amount) @@ -110,14 +105,14 @@ ## else (do r.Monad<Random> - [seed r.nat] + [seed r.i64] (function (_ prng) (let [[prng' instance] (r.run (r.pcg-32 [pcg-32-magic-inc seed]) test)] [prng' (do promise.Monad<Promise> [[counters documentation] instance] (if (failed? counters) - (wrap [counters (format "Failed with this seed: " (%n seed) "\n" documentation)]) - (product.right (r.run prng' (times (n/dec amount) test)))))]))))) + (wrap [counters (times-failure seed documentation)]) + (product.right (r.run prng' (times (dec amount) test)))))]))))) ## [Syntax] (syntax: #export (context: description test) @@ -129,7 +124,7 @@ (loop [counter 0 value 1] (if (i/< 3 counter) - (recur (i/inc counter) (i/* 10 value)) + (recur (inc counter) (i/* 10 value)) value)))) (test "Can create lists easily through macros." @@ -213,47 +208,43 @@ (list.filter product.left) (list/map product.right))))) +(def: (success-message successes failures) + (-> Nat Nat Text) + (format "Test-suite finished." "\n" + (%i (.int successes)) " out of " (%i (.int (n/+ failures successes))) " tests passed." "\n" + (%i (.int failures)) " tests failed." "\n")) + (syntax: #export (run) {#.doc (doc "Runs all the tests defined on the current module, and in all imported modules." (run))} - (with-gensyms [g!successes g!failures g!total-successes g!total-failures g!text/compose] + (with-gensyms [g!successes g!failures g!total-successes g!total-failures] (do @ [current-module macro.current-module-name modules (macro.imported-modules current-module) tests (: (Meta (List [Text Text Text])) - (|> (#.Cons current-module modules) + (|> modules + (#.Cons current-module) list.reverse (monad.map @ exported-tests) - (:: @ map list/join))) - #let [tests+ (list/map (function (_ [module-name test desc]) - (` [(~ (code.text module-name)) (~ (code.symbol [module-name test])) (~ (code.text desc))])) - tests) - num-tests (list.size tests+) - groups (list.split-all promise.parallelism-level tests+)]] + (:: @ map list/join)))] (wrap (list (` (: (~! (IO Top)) ((~! io) (exec ((~! do) (~! promise.Monad<Promise>) [(~' #let) [(~ g!total-successes) +0 (~ g!total-failures) +0] - (~+ (list/join (list/map (function (_ group) - (list (` [(~ g!successes) (~ g!failures)]) (` ((~! run') (list (~+ group)))) - (' #let) (` [(~ g!total-successes) (n/+ (~ g!successes) (~ g!total-successes)) - (~ g!total-failures) (n/+ (~ g!failures) (~ g!total-failures))]))) - groups)))] - (exec (let [(~ g!text/compose) (:: (~! text.Monoid<Text>) (~' compose))] - (log! ($_ (~ g!text/compose) - "Test-suite finished." - "\n" - ((~! %i) (nat-to-int (~ g!total-successes))) - " out of " - ((~! %i) (nat-to-int (n/+ (~ g!total-failures) - (~ g!total-successes)))) - " tests passed." - "\n" - ((~! %i) (nat-to-int (~ g!total-failures))) " tests failed."))) + (~+ (|> tests + (list/map (function (_ [module-name test desc]) + (` [(~ (code.text module-name)) (~ (code.symbol [module-name test])) (~ (code.text desc))]))) + (list.split-all promise.parallelism) + (list/map (function (_ group) + (list (` [(~ g!successes) (~ g!failures)]) (` ((~! run') (list (~+ group)))) + (' #let) (` [(~ g!total-successes) (n/+ (~ g!successes) (~ g!total-successes)) + (~ g!total-failures) (n/+ (~ g!failures) (~ g!total-failures))])))) + list/join))] + (exec (log! ((~! success-message) (~ g!total-successes) (~ g!total-failures))) ((~! promise.future) - (if (n/> +0 (~ g!total-failures)) - (~! ..die) - (~! ..exit))))) + ((~! io.exit) (if (n/> +0 (~ g!total-failures)) + 1 + 0))))) []))))))))) (def: #export (seq left right) diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 61c73835a..93fa324cb 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -228,8 +228,8 @@ (-> Date Text) ($_ text/compose (int/encode year) "-" - (pad (|> month month-to-nat n/inc nat-to-int)) "-" - (pad (|> day nat-to-int)))) + (pad (|> month month-to-nat inc .int)) "-" + (pad (|> day .int)))) (def: lex-year (l.Lexer Int) @@ -260,7 +260,7 @@ (def: leap-year-months (Sequence Nat) - (sequence.update [+1] n/inc normal-months)) + (sequence.update [+1] inc normal-months)) (def: (divisible? factor input) (-> Int Int Bool) @@ -286,13 +286,13 @@ leap-year-months normal-months) month-days (|> months - (sequence.nth (int-to-nat (i/dec utc-month))) + (sequence.nth (.nat (dec utc-month))) maybe.assume)] _ (l.this "-") utc-day lex-section _ (p.assert "Invalid day." (and (i/>= 1 utc-day) - (i/<= (nat-to-int month-days) utc-day)))] + (i/<= (.int month-days) utc-day)))] (wrap {#year utc-year #month (case utc-month 1 #January @@ -308,7 +308,7 @@ 11 #November 12 #December _ (undefined)) - #day (int-to-nat utc-day)}))) + #day (.nat utc-day)}))) (def: (decode input) (-> Text (e.Error Date)) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 018eeb936..c4d3c6fdf 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -97,8 +97,8 @@ (if (i/= 0 (duration.query year time-left)) [reference time-left] (if (duration/>= duration.empty time-left) - (recur (i/inc reference) (duration.merge (duration.scale -1 year) time-left)) - (recur (i/dec reference) (duration.merge year time-left))) + (recur (inc reference) (duration.merge (duration.scale -1 year) time-left)) + (recur (dec reference) (duration.merge year time-left))) )))) (def: normal-months @@ -110,23 +110,23 @@ (def: leap-year-months (Sequence Nat) - (sequence.update [+1] n/inc normal-months)) + (sequence.update [+1] inc normal-months)) (def: (find-month months time) (-> (Sequence Nat) duration.Duration [Nat duration.Duration]) (if (duration/>= duration.empty time) (sequence/fold (function (_ month-days [current-month time-left]) - (let [month-duration (duration.scale (nat-to-int month-days) duration.day)] + (let [month-duration (duration.scale (.int month-days) duration.day)] (if (i/= 0 (duration.query month-duration time-left)) [current-month time-left] - [(n/inc current-month) (duration.merge (duration.scale -1 month-duration) time-left)]))) + [(inc current-month) (duration.merge (duration.scale -1 month-duration) time-left)]))) [+0 time] months) (sequence/fold (function (_ month-days [current-month time-left]) - (let [month-duration (duration.scale (nat-to-int month-days) duration.day)] + (let [month-duration (duration.scale (.int month-days) duration.day)] (if (i/= 0 (duration.query month-duration time-left)) [current-month time-left] - [(n/dec current-month) (duration.merge month-duration time-left)]))) + [(dec current-month) (duration.merge month-duration time-left)]))) [+11 time] (sequence.reverse months)))) @@ -176,7 +176,7 @@ day-time (duration.frame duration.day offset) days-of-year (if (duration/>= duration.empty day-time) days-of-year - (i/dec days-of-year)) + (dec days-of-year)) mp (|> days-of-year (i/* 5) (i/+ 2) (i// 153)) day (|> days-of-year (i/- (|> mp (i/* 153) (i/+ 2) (i// 5))) @@ -186,7 +186,7 @@ 3 -9))) year (if (i/<= 2 month) - (i/inc year) + (inc year) year)] [[year month day] day-time])) @@ -251,13 +251,13 @@ leap-year-months normal-months) month-days (|> months - (sequence.nth (int-to-nat (i/dec utc-month))) + (sequence.nth (.nat (dec utc-month))) maybe.assume)] _ (l.this "-") utc-day lex-section _ (p.assert "Invalid day." (and (i/>= 1 utc-day) - (i/<= (nat-to-int month-days) utc-day))) + (i/<= (.int month-days) utc-day))) _ (l.this "T") utc-hour lex-section _ (p.assert "Invalid hour." @@ -277,16 +277,16 @@ _ (l.this "Z") #let [years-since-epoch (i/- epoch-year utc-year) previous-leap-days (i/- (leap-years epoch-year) - (leap-years (i/dec utc-year))) + (leap-years (dec utc-year))) year-days-so-far (|> (i/* 365 years-since-epoch) (i/+ previous-leap-days)) month-days-so-far (|> months sequence.to-list - (list.take (int-to-nat (i/dec utc-month))) + (list.take (.nat (dec utc-month))) (L/fold n/+ +0)) total-days (|> year-days-so-far - (i/+ (nat-to-int month-days-so-far)) - (i/+ (i/dec utc-day)))]] + (i/+ (.int month-days-so-far)) + (i/+ (dec utc-day)))]] (wrap (|> epoch (shift (duration.scale total-days duration.day)) (shift (duration.scale utc-hour duration.hour)) @@ -314,7 +314,7 @@ (-> Instant date.Date) (let [[[year month day] _] (extract-date instant)] {#date.year year - #date.month (case (i/dec month) + #date.month (case (dec month) 0 #date.January 1 #date.February 2 #date.March @@ -328,7 +328,7 @@ 10 #date.November 11 #date.December _ (undefined)) - #date.day (int-to-nat day)})) + #date.day (.nat day)})) (def: #export (month instant) (-> Instant date.Month) @@ -342,7 +342,7 @@ day-time (duration.frame duration.day offset) days (if (and (duration.negative? offset) (not (duration.neutral? day-time))) - (i/dec days) + (dec days) days) ## 1970/01/01 was a Thursday y1970m0d0 4] diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 0decd9dba..0d6f5b4df 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -66,7 +66,7 @@ (#.Product left right) (if (n/= +0 idx) (:: tc.Monad<Check> wrap left) - (find-member-type (n/dec idx) right)) + (find-member-type (dec idx) right)) _ (if (n/= +0 idx) @@ -328,7 +328,7 @@ (list.n/range +1 +10) (list.n/range +1 +10)) "(Functor List) map" - (::: map n/inc (list.n/range +0 +9)) + (::: map inc (list.n/range +0 +9)) "Caveat emptor: You need to make sure to import the module of any structure you want to use." "Otherwise, this macro will not find it.")} (case args diff --git a/stdlib/source/lux/type/object/interface.lux b/stdlib/source/lux/type/object/interface.lux index f94177cd0..393fa929f 100644 --- a/stdlib/source/lux/type/object/interface.lux +++ b/stdlib/source/lux/type/object/interface.lux @@ -64,7 +64,7 @@ (if (list.empty? ancestors) (list) (|> (list.size ancestors) - n/dec + dec (list.n/range +0) (list/map (|>> %n (format "ancestor") code.local-symbol))))) @@ -102,7 +102,7 @@ g!_behavior (code.symbol ["" "_behavior"]) g!_state (code.symbol ["" "_state"]) g!_extension (code.symbol ["" "_extension"]) - g!_args (list/map (|>> product.left nat-to-int %i (format "_") code.local-symbol) + g!_args (list/map (|>> product.left .int %i (format "_") code.local-symbol) (list.enumerate inputs)) g!destructuring (list/fold (function (_ _ g!bottom) (` [(~ g!_temp) (~ g!_temp) (~ g!bottom)])) (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]) @@ -166,7 +166,7 @@ currentT newT] (case currentT (#.UnivQ _ bodyT) - (recur (n/inc depth) bodyT) + (recur (inc depth) bodyT) (#.Function inputT outputT) (let [[stateT+ objectT] (type.flatten-function currentT)] @@ -182,9 +182,9 @@ typeC size - (|> (n/dec size) + (|> (dec size) (list.n/range +0) - (list/map (|>> (n/* +2) n/inc code.nat (~) #.Bound (`))) + (list/map (|>> (n/* +2) inc code.nat (~) #.Bound (`))) (list.zip2 (list.reverse mappings)) (list/fold (function (_ [mappingC boundC] genericC) (code.replace boundC mappingC genericC)) diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux index 4558fa3a4..c25db4aab 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -150,7 +150,7 @@ (#.Cons head tail) (do macro.Monad<Meta> [#let [max-idx (list/fold n/max head tail)] - g!inputs (<| (monad.seq @) (list.repeat (n/inc max-idx)) (macro.gensym "input")) + g!inputs (<| (monad.seq @) (list.repeat (inc max-idx)) (macro.gensym "input")) #let [g!outputs (|> (monad.fold maybe.Monad<Maybe> (function (_ from to) (do maybe.Monad<Maybe> diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index 1615a47c7..2af12b5df 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -82,7 +82,7 @@ denominator s.int _ (p.assert (format "Denominator must be positive: " (%i denominator)) (i/> 0 denominator))] - (wrap [(int-to-nat numerator) (int-to-nat denominator)])))) + (wrap [(.nat numerator) (.nat denominator)])))) (syntax: #export (scale: {export csr.export} @@ -97,13 +97,13 @@ (..Scale (~ g!scale)) (def: (~' scale) (|>> ..out - (i/* (~ (code.int (nat-to-int numerator)))) - (i// (~ (code.int (nat-to-int denominator)))) + (i/* (~ (code.int (.int numerator)))) + (i// (~ (code.int (.int denominator)))) ..in)) (def: (~' de-scale) (|>> ..out - (i/* (~ (code.int (nat-to-int denominator)))) - (i// (~ (code.int (nat-to-int numerator)))) + (i/* (~ (code.int (.int denominator)))) + (i// (~ (code.int (.int numerator)))) ..in)) (def: (~' ratio) [(~ (code.nat numerator)) (~ (code.nat denominator))]))) @@ -139,8 +139,8 @@ (let [[numerator denominator] (|> (:: to ratio) (r.r// (:: from ratio)))] (|> quantity out - (i/* (nat-to-int numerator)) - (i// (nat-to-int denominator)) + (i/* (.int numerator)) + (i// (.int denominator)) in))) (scale: #export Kilo [1 1_000]) @@ -174,5 +174,5 @@ (struct: #export Enum<Unit> (All [unit] (Enum (Qty unit))) (def: order Order<Unit>) - (def: succ (|>> ..out i/inc ..in)) - (def: pred (|>> ..out i/dec ..in))) + (def: succ (|>> ..out inc ..in)) + (def: pred (|>> ..out dec ..in))) diff --git a/stdlib/source/lux/world/blob.jvm.lux b/stdlib/source/lux/world/blob.jvm.lux index 077fa3863..2cb4ed291 100644 --- a/stdlib/source/lux/world/blob.jvm.lux +++ b/stdlib/source/lux/world/blob.jvm.lux @@ -1,5 +1,5 @@ (.module: - lux + [lux #- i64] (lux (control [monad #+ do] ["ex" exception #+ exception:] [eq]) @@ -22,96 +22,100 @@ (#static equals [(Array byte) (Array byte)] boolean)) (def: byte-mask - Nat - (|> +1 (bit.left-shift +8) n/dec)) + I64 + (|> +1 (bit.left-shift +8) dec .i64)) -(def: byte-to-nat - (-> (primitive "java.lang.Byte") Nat) - (|>> host.byte-to-long (:! Nat) (bit.and byte-mask))) +(def: i64 + (-> (primitive "java.lang.Byte") I64) + (|>> host.byte-to-long (:! I64) (bit.and byte-mask))) + +(def: byte + (-> (I64 Top) (primitive "java.lang.Byte")) + (|>> .int host.long-to-byte)) (def: #export (create size) (-> Nat Blob) (host.array byte size)) (def: #export (read-8 idx blob) - (-> Nat Blob (e.Error Nat)) + (-> Nat Blob (e.Error I64)) (if (n/< (host.array-length blob) idx) - (|> (host.array-read idx blob) byte-to-nat #e.Success) + (|> (host.array-read idx blob) ..i64 #e.Success) (ex.throw index-out-of-bounds (%n idx)))) (def: #export (read-16 idx blob) - (-> Nat Blob (e.Error Nat)) + (-> Nat Blob (e.Error I64)) (if (n/< (host.array-length blob) (n/+ +1 idx)) (#e.Success ($_ bit.or - (bit.left-shift +8 (byte-to-nat (host.array-read idx blob))) - (byte-to-nat (host.array-read (n/+ +1 idx) blob)))) + (bit.left-shift +8 (..i64 (host.array-read idx blob))) + (..i64 (host.array-read (n/+ +1 idx) blob)))) (ex.throw index-out-of-bounds (%n idx)))) (def: #export (read-32 idx blob) - (-> Nat Blob (e.Error Nat)) + (-> Nat Blob (e.Error I64)) (if (n/< (host.array-length blob) (n/+ +3 idx)) (#e.Success ($_ bit.or - (bit.left-shift +24 (byte-to-nat (host.array-read idx blob))) - (bit.left-shift +16 (byte-to-nat (host.array-read (n/+ +1 idx) blob))) - (bit.left-shift +8 (byte-to-nat (host.array-read (n/+ +2 idx) blob))) - (byte-to-nat (host.array-read (n/+ +3 idx) blob)))) + (bit.left-shift +24 (..i64 (host.array-read idx blob))) + (bit.left-shift +16 (..i64 (host.array-read (n/+ +1 idx) blob))) + (bit.left-shift +8 (..i64 (host.array-read (n/+ +2 idx) blob))) + (..i64 (host.array-read (n/+ +3 idx) blob)))) (ex.throw index-out-of-bounds (%n idx)))) (def: #export (read-64 idx blob) - (-> Nat Blob (e.Error Nat)) + (-> Nat Blob (e.Error I64)) (if (n/< (host.array-length blob) (n/+ +7 idx)) (#e.Success ($_ bit.or - (bit.left-shift +56 (byte-to-nat (host.array-read idx blob))) - (bit.left-shift +48 (byte-to-nat (host.array-read (n/+ +1 idx) blob))) - (bit.left-shift +40 (byte-to-nat (host.array-read (n/+ +2 idx) blob))) - (bit.left-shift +32 (byte-to-nat (host.array-read (n/+ +3 idx) blob))) - (bit.left-shift +24 (byte-to-nat (host.array-read (n/+ +4 idx) blob))) - (bit.left-shift +16 (byte-to-nat (host.array-read (n/+ +5 idx) blob))) - (bit.left-shift +8 (byte-to-nat (host.array-read (n/+ +6 idx) blob))) - (byte-to-nat (host.array-read (n/+ +7 idx) blob)))) + (bit.left-shift +56 (..i64 (host.array-read idx blob))) + (bit.left-shift +48 (..i64 (host.array-read (n/+ +1 idx) blob))) + (bit.left-shift +40 (..i64 (host.array-read (n/+ +2 idx) blob))) + (bit.left-shift +32 (..i64 (host.array-read (n/+ +3 idx) blob))) + (bit.left-shift +24 (..i64 (host.array-read (n/+ +4 idx) blob))) + (bit.left-shift +16 (..i64 (host.array-read (n/+ +5 idx) blob))) + (bit.left-shift +8 (..i64 (host.array-read (n/+ +6 idx) blob))) + (..i64 (host.array-read (n/+ +7 idx) blob)))) (ex.throw index-out-of-bounds (%n idx)))) (def: #export (write-8 idx value blob) - (-> Nat Nat Blob (e.Error Top)) + (-> Nat (I64 Top) Blob (e.Error Blob)) (if (n/< (host.array-length blob) idx) (exec (|> blob - (host.array-write idx (host.long-to-byte (:! Int value)))) - (#e.Success [])) + (host.array-write idx (..byte value))) + (#e.Success blob)) (ex.throw index-out-of-bounds (%n idx)))) (def: #export (write-16 idx value blob) - (-> Nat Nat Blob (e.Error Top)) + (-> Nat (I64 Top) Blob (e.Error Blob)) (if (n/< (host.array-length blob) (n/+ +1 idx)) (exec (|> blob - (host.array-write idx (host.long-to-byte (:! Int (bit.logical-right-shift +8 value)))) - (host.array-write (n/+ +1 idx) (host.long-to-byte (:! Int value)))) - (#e.Success [])) + (host.array-write idx (..byte (bit.logical-right-shift +8 value))) + (host.array-write (n/+ +1 idx) (..byte value))) + (#e.Success blob)) (ex.throw index-out-of-bounds (%n idx)))) (def: #export (write-32 idx value blob) - (-> Nat Nat Blob (e.Error Top)) + (-> Nat (I64 Top) Blob (e.Error Blob)) (if (n/< (host.array-length blob) (n/+ +3 idx)) (exec (|> blob - (host.array-write idx (host.long-to-byte (:! Int (bit.logical-right-shift +24 value)))) - (host.array-write (n/+ +1 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +16 value)))) - (host.array-write (n/+ +2 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +8 value)))) - (host.array-write (n/+ +3 idx) (host.long-to-byte (:! Int value)))) - (#e.Success [])) + (host.array-write idx (..byte (bit.logical-right-shift +24 value))) + (host.array-write (n/+ +1 idx) (..byte (bit.logical-right-shift +16 value))) + (host.array-write (n/+ +2 idx) (..byte (bit.logical-right-shift +8 value))) + (host.array-write (n/+ +3 idx) (..byte value))) + (#e.Success blob)) (ex.throw index-out-of-bounds (%n idx)))) (def: #export (write-64 idx value blob) - (-> Nat Nat Blob (e.Error Top)) + (-> Nat (I64 Top) Blob (e.Error Blob)) (if (n/< (host.array-length blob) (n/+ +7 idx)) (exec (|> blob - (host.array-write idx (host.long-to-byte (:! Int (bit.logical-right-shift +56 value)))) - (host.array-write (n/+ +1 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +48 value)))) - (host.array-write (n/+ +2 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +40 value)))) - (host.array-write (n/+ +3 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +32 value)))) - (host.array-write (n/+ +4 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +24 value)))) - (host.array-write (n/+ +5 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +16 value)))) - (host.array-write (n/+ +6 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +8 value)))) - (host.array-write (n/+ +7 idx) (host.long-to-byte (:! Int value)))) - (#e.Success [])) + (host.array-write idx (..byte (bit.logical-right-shift +56 value))) + (host.array-write (n/+ +1 idx) (..byte (bit.logical-right-shift +48 value))) + (host.array-write (n/+ +2 idx) (..byte (bit.logical-right-shift +40 value))) + (host.array-write (n/+ +3 idx) (..byte (bit.logical-right-shift +32 value))) + (host.array-write (n/+ +4 idx) (..byte (bit.logical-right-shift +24 value))) + (host.array-write (n/+ +5 idx) (..byte (bit.logical-right-shift +16 value))) + (host.array-write (n/+ +6 idx) (..byte (bit.logical-right-shift +8 value))) + (host.array-write (n/+ +7 idx) (..byte value))) + (#e.Success blob)) (ex.throw index-out-of-bounds (%n idx)))) (def: #export (size blob) @@ -130,11 +134,11 @@ (ex.throw index-out-of-bounds <description>) ## else - (#e.Success (Arrays::copyOfRange [blob (:! Int from) (:! Int (n/inc to))])))))) + (#e.Success (Arrays::copyOfRange [blob (:! Int from) (:! Int (inc to))])))))) (def: #export (slice' from blob) (-> Nat Blob (e.Error Blob)) - (slice from (n/dec (host.array-length blob)) blob)) + (slice from (dec (host.array-length blob)) blob)) (struct: #export _ (eq.Eq Blob) (def: (= reference sample) diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index 349c8853c..7e5d72790 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -48,7 +48,7 @@ (|>> get@Console (get@ #input) (InputStream::read []) - (:: io.Functor<Process> map (|>> int-to-nat text.from-code)) + (:: io.Functor<Process> map (|>> .nat text.from-code)) promise.future)) (def: (read-line console) @@ -57,7 +57,7 @@ (promise.future (loop [_ []] (do io.Monad<Process> - [char (<| (:: @ map (|>> int-to-nat text.from-code)) + [char (<| (:: @ map (|>> .nat text.from-code)) (InputStream::read [] input))] (case char "\n" @@ -69,7 +69,7 @@ (if (i/> 0 available) (do @ [_ (InputStream::mark [10] input) - next (<| (:: @ map (|>> int-to-nat text.from-code)) + next (<| (:: @ map (|>> .nat text.from-code)) (InputStream::read [] input))] (case next "\n" diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 93a7bdd73..92fdd1501 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -69,7 +69,7 @@ (do io.Monad<Process> [#let [file' (java/io/File::new file)] size (java/io/File::length [] file') - #let [data (blob.create (int-to-nat size))] + #let [data (blob.create (.nat size))] stream (FileInputStream::new [file']) bytes-read (InputStream::read [data] stream) _ (AutoCloseable::close [] stream)] @@ -81,7 +81,7 @@ (-> File (Process Nat)) (do io.Monad<Process> [size (java/io/File::length [] (java/io/File::new file))] - (wrap (int-to-nat size)))) + (wrap (.nat size)))) (def: #export (files dir) (-> File (Process (List File))) diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux index 38721662f..a0cfbc4b6 100644 --- a/stdlib/source/lux/world/net/tcp.jvm.lux +++ b/stdlib/source/lux/world/net/tcp.jvm.lux @@ -45,16 +45,16 @@ (-> Blob Nat Nat TCP (Task Nat)) (promise.future (do io.Monad<Process> - [bytes-read (InputStream::read [data (nat-to-int offset) (nat-to-int length)] + [bytes-read (InputStream::read [data (.int offset) (.int length)] (get@ #in (@representation self)))] - (wrap (int-to-nat bytes-read))))) + (wrap (.nat bytes-read))))) (def: #export (write data offset length self) (-> Blob Nat Nat TCP (Task Top)) (let [out (get@ #out (@representation self))] (promise.future (do io.Monad<Process> - [_ (OutputStream::write [data (nat-to-int offset) (nat-to-int length)] + [_ (OutputStream::write [data (.int offset) (.int length)] out)] (Flushable::flush [] out))))) @@ -81,7 +81,7 @@ (-> //.Address //.Port (Task TCP)) (promise.future (do io.Monad<Process> - [socket (Socket::new [address (nat-to-int port)])] + [socket (Socket::new [address (.int port)])] (tcp-client socket)))) (def: #export (server port) @@ -89,7 +89,7 @@ (frp.Channel TCP)])) (promise.future (do (e.ErrorT io.Monad<IO>) - [server (ServerSocket::new [(nat-to-int port)]) + [server (ServerSocket::new [(.int port)]) #let [signal (: (Promise Top) (promise #.None)) _ (promise.await (function (_ _) diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index a28adc6bd..da4f8f05d 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -62,14 +62,14 @@ (def: #export (read data offset length self) (-> Blob Nat Nat UDP (T.Task [Nat //.Address //.Port])) (let [(^open) (@representation self) - packet (DatagramPacket::new|receive [data (nat-to-int offset) (nat-to-int length)])] + packet (DatagramPacket::new|receive [data (.int offset) (.int length)])] (P.future (do (e.ErrorT io.Monad<IO>) [_ (DatagramSocket::receive [packet] socket) - #let [bytes-read (int-to-nat (DatagramPacket::getLength [] packet))]] + #let [bytes-read (.nat (DatagramPacket::getLength [] packet))]] (wrap [bytes-read (|> packet (DatagramPacket::getAddress []) (InetAddress::getHostAddress [])) - (int-to-nat (DatagramPacket::getPort [] packet))]))))) + (.nat (DatagramPacket::getPort [] packet))]))))) (def: #export (write address port data offset length self) (-> //.Address //.Port Blob Nat Nat UDP (T.Task Top)) @@ -77,7 +77,7 @@ (do (e.ErrorT io.Monad<IO>) [address (resolve address) #let [(^open) (@representation self)]] - (DatagramSocket::send (DatagramPacket::new|send [data (nat-to-int offset) (nat-to-int length) address (nat-to-int port)]) + (DatagramSocket::send (DatagramPacket::new|send [data (.int offset) (.int length) address (.int port)]) socket)))) (def: #export (close self) @@ -97,6 +97,6 @@ (-> //.Port (T.Task UDP)) (P.future (do (e.ErrorT io.Monad<IO>) - [socket (DatagramSocket::new|server [(nat-to-int port)])] + [socket (DatagramSocket::new|server [(.int port)])] (wrap (@abstraction (#socket socket)))))) ) |