aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/fold.lux14
-rw-r--r--stdlib/source/lux/control/monoid.lux8
-rw-r--r--stdlib/source/lux/data/collection/array.lux4
-rw-r--r--stdlib/source/lux/data/collection/list.lux60
-rw-r--r--stdlib/source/lux/data/collection/row.lux12
-rw-r--r--stdlib/source/lux/data/number/i64.lux16
-rw-r--r--stdlib/source/lux/data/text.lux2
-rw-r--r--stdlib/source/lux/host.jvm.lux2
-rw-r--r--stdlib/source/lux/type.lux6
-rw-r--r--stdlib/source/lux/world/binary.lux84
10 files changed, 118 insertions, 90 deletions
diff --git a/stdlib/source/lux/control/fold.lux b/stdlib/source/lux/control/fold.lux
index 8dc388045..d38b151bc 100644
--- a/stdlib/source/lux/control/fold.lux
+++ b/stdlib/source/lux/control/fold.lux
@@ -1,8 +1,18 @@
-(.module: lux)
+(.module:
+ [lux #*]
+ [//
+ [monoid (#+ Monoid)]])
-## [Signatures]
(signature: #export (Fold F)
{#.doc "Iterate over a structure's values to build a summary value."}
(: (All [a b]
(-> (-> b a a) a (F b) a))
fold))
+
+(def: #export (with-monoid monoid fold value)
+ (All [F a]
+ (-> (Monoid a) (Fold F) (F a) a))
+ (let [(^open "monoid/.") monoid]
+ (fold monoid/compose
+ monoid/identity
+ value)))
diff --git a/stdlib/source/lux/control/monoid.lux b/stdlib/source/lux/control/monoid.lux
index 7d89043a8..33d082020 100644
--- a/stdlib/source/lux/control/monoid.lux
+++ b/stdlib/source/lux/control/monoid.lux
@@ -1,6 +1,5 @@
(.module:
- lux
- [// [fold (#+ Fold)]])
+ [lux #*])
(signature: #export (Monoid a)
{#.doc (doc "A way to compose values."
@@ -18,8 +17,3 @@
(def: (compose [lL rL] [lR rR])
[(:: Monoid<l> compose lL lR)
(:: Monoid<r> compose rL rR)])))
-
-(def: #export (fold Monoid<a> Fold<F> data)
- (All [a F] (-> (Monoid a) (Fold F) (F a) a))
- (let [(^open "a/.") Monoid<a>]
- (:: Fold<F> fold a/compose a/identity data)))
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index 6bd59d7b5..8c1b5c2b3 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -15,11 +15,11 @@
[compiler
["." host]]]])
-(def: #export array-type-name "#Array")
+(def: #export type-name "#Array")
(type: #export (Array a)
{#.doc "Mutable arrays."}
- (#.Primitive array-type-name (#.Cons a #.Nil)))
+ (#.Primitive ..type-name (#.Cons a #.Nil)))
(def: #export (new size)
(All [a] (-> Nat (Array a)))
diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux
index c49a7ba9f..a92175d53 100644
--- a/stdlib/source/lux/data/collection/list.lux
+++ b/stdlib/source/lux/data/collection/list.lux
@@ -6,7 +6,8 @@
[apply (#+ Apply)]
["." monad (#+ do Monad)]
[equivalence (#+ Equivalence)]
- [fold (#+ Fold)]]
+ [fold (#+ Fold)]
+ [predicate (#+ Predicate)]]
[data
bit
["." product]]])
@@ -35,22 +36,23 @@
#.Nil
xs))
-(def: #export (filter p xs)
+(def: #export (filter predicate xs)
(All [a]
- (-> (-> a Bit) (List a) (List a)))
+ (-> (Predicate a) (List a) (List a)))
(case xs
#.Nil
#.Nil
(#.Cons [x xs'])
- (if (p x)
- (#.Cons [x (filter p xs')])
- (filter p xs'))))
+ (if (predicate x)
+ (#.Cons x (filter predicate xs'))
+ (filter predicate xs'))))
-(def: #export (partition p xs)
+(def: #export (partition predicate xs)
{#.doc "Divide the list into all elements that satisfy a predicate, and all elements that do not."}
- (All [a] (-> (-> a Bit) (List a) [(List a) (List a)]))
- [(filter p xs) (filter (complement p) xs)])
+ (All [a] (-> (Predicate a) (List a) [(List a) (List a)]))
+ [(filter predicate xs)
+ (filter (complement predicate) xs)])
(def: #export (as-pairs xs)
{#.doc (doc "Cut the list into pairs of 2."
@@ -81,20 +83,20 @@
)
(do-template [<name> <then> <else>]
- [(def: #export (<name> p xs)
+ [(def: #export (<name> predicate xs)
(All [a]
- (-> (-> a Bit) (List a) (List a)))
+ (-> (Predicate a) (List a) (List a)))
(case xs
#.Nil
#.Nil
(#.Cons [x xs'])
- (if (p x)
+ (if (predicate x)
<then>
<else>)))]
- [take-while (#.Cons [x (take-while p xs')]) #.Nil]
- [drop-while (drop-while p xs') xs]
+ [take-while (#.Cons [x (take-while predicate xs')]) #.Nil]
+ [drop-while (drop-while predicate xs') xs]
)
(def: #export (split n xs)
@@ -110,23 +112,23 @@
[(#.Cons [x tail]) rest]))
[#.Nil xs]))
-(def: (split-with' p ys xs)
+(def: (split-with' predicate ys xs)
(All [a]
- (-> (-> a Bit) (List a) (List a) [(List a) (List a)]))
+ (-> (Predicate a) (List a) (List a) [(List a) (List a)]))
(case xs
#.Nil
[ys xs]
(#.Cons [x xs'])
- (if (p x)
- (split-with' p (#.Cons [x ys]) xs')
+ (if (predicate x)
+ (split-with' predicate (#.Cons [x ys]) xs')
[ys xs])))
-(def: #export (split-with p xs)
+(def: #export (split-with predicate xs)
{#.doc "Segment the list by using a predicate to tell when to cut."}
(All [a]
- (-> (-> a Bit) (List a) [(List a) (List a)]))
- (let [[ys' xs'] (split-with' p #.Nil xs)]
+ (-> (Predicate a) (List a) [(List a) (List a)]))
+ (let [[ys' xs'] (split-with' predicate #.Nil xs)]
[(reverse ys') xs']))
(def: #export (split-all n xs)
@@ -169,18 +171,18 @@
#.None
(list x)))
-(def: #export (find p xs)
+(def: #export (find predicate xs)
{#.doc "Returns the first value in the list for which the predicate is #1."}
(All [a]
- (-> (-> a Bit) (List a) (Maybe a)))
+ (-> (Predicate a) (List a) (Maybe a)))
(case xs
#.Nil
#.None
(#.Cons [x xs'])
- (if (p x)
+ (if (predicate x)
(#.Some x)
- (find p xs'))))
+ (find predicate xs'))))
(def: #export (search check xs)
(All [a b]
@@ -231,16 +233,16 @@
(fold (function (_ _ acc) (n/+ 1 acc)) 0 list))
(do-template [<name> <init> <op>]
- [(def: #export (<name> p xs)
+ [(def: #export (<name> predicate xs)
(All [a]
- (-> (-> a Bit) (List a) Bit))
+ (-> (Predicate a) (List a) Bit))
(loop [xs xs]
(case xs
#.Nil
<init>
(#.Cons x xs')
- (case (p x)
+ (case (predicate x)
<init>
(recur xs')
@@ -351,7 +353,7 @@
)
(def: #export (empty? xs)
- (All [a] (-> (List a) Bit))
+ (All [a] (Predicate (List a)))
(case xs
#.Nil #1
_ #0))
diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux
index d388d6ede..f495cf755 100644
--- a/stdlib/source/lux/data/collection/row.lux
+++ b/stdlib/source/lux/data/collection/row.lux
@@ -326,11 +326,9 @@
(list/compose (to-list' (#Hierarchy (get@ #root vec)))
(to-list' (#Base (get@ #tail vec)))))
-(def: #export (from-list list)
+(def: #export from-list
(All [a] (-> (List a) (Row a)))
- (list/fold add
- empty
- list))
+ (list/fold ..add ..empty))
(def: #export (member? a/Equivalence vec val)
(All [a] (-> (Equivalence a) (Row a) a Bit))
@@ -389,9 +387,9 @@
(#Base (get@ #tail xs))))))
(structure: #export Monoid<Row> (All [a] (Monoid (Row a)))
- (def: identity empty)
+ (def: identity ..empty)
(def: (compose xs ys)
- (list/fold add xs (to-list ys))))
+ (list/fold add xs (..to-list ys))))
(structure: _ (Functor Node)
(def: (map f xs)
@@ -430,6 +428,8 @@
(^open ".") Monoid<Row>]
(fold (function (_ post pre) (compose pre post)) identity))))
+## TODO: This definition of 'reverse' shouldn't work correctly.
+## Investigate if/why it does.
(def: #export reverse
(All [a] (-> (Row a) (Row a)))
(let [(^open ".") Fold<Row>
diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/data/number/i64.lux
index aba61ad3e..fff288998 100644
--- a/stdlib/source/lux/data/number/i64.lux
+++ b/stdlib/source/lux/data/number/i64.lux
@@ -1,12 +1,18 @@
(.module: [lux (#- and or not)])
-(def: #export width Nat 64)
+(def: #export bits-per-byte 8)
+
+(def: #export bytes-per-i64 8)
+
+(def: #export width
+ Nat
+ (n/* bits-per-byte
+ bytes-per-i64))
-## [Values]
(do-template [<name> <op> <doc>]
[(def: #export (<name> param subject)
{#.doc <doc>}
- (All [s] (-> (I64 s) (I64 s) (I64 s)))
+ (All [s] (-> (I64 Any) (I64 s) (I64 s)))
(<op> param subject))]
[and "lux i64 and" "Bitwise and."]
@@ -25,6 +31,10 @@
[arithmetic-right-shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."]
)
+(def: #export (mask bits)
+ (-> Nat (I64 Any))
+ (|> 1 (..left-shift (n/% ..width bits)) .dec))
+
(def: (add-shift shift value)
(-> Nat Nat Nat)
(|> value (logical-right-shift shift) (n/+ value)))
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 6c427f151..777c7da22 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -19,6 +19,8 @@
(type: #export Char Nat)
+## TODO: Instead of ints, chars should be produced fron nats.
+## (The JVM specifies chars as 16-bit unsigned integers)
(def: #export from-code
(-> Char Text)
(|>> (:coerce Int) "lux int char"))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 59996d9a2..8a6a9f43c 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1106,7 +1106,7 @@
(format "(" (sanitize name) " " (spaced (list/map generic-type$ params)) ")")
(#GenericArray param)
- (format "(" array.array-type-name " " (generic-type$ param) ")")
+ (format "(" array.type-name " " (generic-type$ param) ")")
(#GenericWildcard #.None)
"?"
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index 1312e2a82..3615ac808 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -331,11 +331,11 @@
_
#0))
-(def: #export (array level elem-type)
+(def: #export (array depth elem-type)
(-> Nat Type Type)
- (case level
+ (case depth
0 elem-type
- _ (|> elem-type (array (dec level)) (list) (#.Primitive array.array-type-name))))
+ _ (|> elem-type (array (dec depth)) (list) (#.Primitive array.type-name))))
(syntax: #export (:log! {input (p.or s.identifier
s.any)})
diff --git a/stdlib/source/lux/world/binary.lux b/stdlib/source/lux/world/binary.lux
index f3ee40042..7f3e3123d 100644
--- a/stdlib/source/lux/world/binary.lux
+++ b/stdlib/source/lux/world/binary.lux
@@ -15,11 +15,19 @@
[array (#+ Array)]]]
["." host (#+ import:)]])
-(exception: #export (index-out-of-bounds {description Text})
- description)
+(exception: #export (index-out-of-bounds {size Nat} {index Nat})
+ (ex.report ["Size" (%n size)]
+ ["Index" (%n index)]))
-(exception: #export (inverted-range {description Text})
- description)
+(do-template [<name>]
+ [(exception: #export (<name> {size Nat} {from Nat} {to Nat})
+ (ex.report ["Size" (%n size)]
+ ["From" (%n from)]
+ ["To" (%n to)]))]
+
+ [slice-out-of-bounds]
+ [inverted-slice]
+ )
(type: #export Binary (host.type (Array byte)))
@@ -32,47 +40,54 @@
(def: byte-mask
I64
- (|> 1 (i64.left-shift 8) dec .i64))
+ (|> i64.bits-per-byte i64.mask .i64))
(def: i64
(-> (primitive "java.lang.Byte") I64)
- (|>> host.byte-to-long (:coerce I64) (i64.and byte-mask)))
+ (|>> host.byte-to-long (:coerce I64) (i64.and ..byte-mask)))
(def: byte
(-> (I64 Any) (primitive "java.lang.Byte"))
(|>> .int host.long-to-byte))
+(template: (!size binary)
+ (host.array-length binary))
+
+(def: #export size
+ (-> Binary Nat)
+ (|>> !size))
+
(def: #export (create size)
(-> Nat Binary)
(host.array byte size))
(def: #export (read/8 idx binary)
(-> Nat Binary (Error I64))
- (if (n/< (host.array-length binary) idx)
- (|> (host.array-read idx binary) ..i64 #error.Success)
- (ex.throw index-out-of-bounds (%n idx))))
+ (if (n/< (..!size binary) idx)
+ (#error.Success (..i64 (host.array-read idx binary)))
+ (ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (read/16 idx binary)
(-> Nat Binary (Error I64))
- (if (n/< (host.array-length binary) (n/+ 1 idx))
+ (if (n/< (..!size binary) (n/+ 1 idx))
(#error.Success ($_ i64.or
(i64.left-shift 8 (..i64 (host.array-read idx binary)))
(..i64 (host.array-read (n/+ 1 idx) binary))))
- (ex.throw index-out-of-bounds (%n idx))))
+ (ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (read/32 idx binary)
(-> Nat Binary (Error I64))
- (if (n/< (host.array-length binary) (n/+ 3 idx))
+ (if (n/< (..!size binary) (n/+ 3 idx))
(#error.Success ($_ i64.or
(i64.left-shift 24 (..i64 (host.array-read idx binary)))
(i64.left-shift 16 (..i64 (host.array-read (n/+ 1 idx) binary)))
(i64.left-shift 8 (..i64 (host.array-read (n/+ 2 idx) binary)))
(..i64 (host.array-read (n/+ 3 idx) binary))))
- (ex.throw index-out-of-bounds (%n idx))))
+ (ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (read/64 idx binary)
(-> Nat Binary (Error I64))
- (if (n/< (host.array-length binary) (n/+ 7 idx))
+ (if (n/< (..!size binary) (n/+ 7 idx))
(#error.Success ($_ i64.or
(i64.left-shift 56 (..i64 (host.array-read idx binary)))
(i64.left-shift 48 (..i64 (host.array-read (n/+ 1 idx) binary)))
@@ -82,39 +97,39 @@
(i64.left-shift 16 (..i64 (host.array-read (n/+ 5 idx) binary)))
(i64.left-shift 8 (..i64 (host.array-read (n/+ 6 idx) binary)))
(..i64 (host.array-read (n/+ 7 idx) binary))))
- (ex.throw index-out-of-bounds (%n idx))))
+ (ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (write/8 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
- (if (n/< (host.array-length binary) idx)
+ (if (n/< (..!size binary) idx)
(exec (|> binary
(host.array-write idx (..byte value)))
(#error.Success binary))
- (ex.throw index-out-of-bounds (%n idx))))
+ (ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (write/16 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
- (if (n/< (host.array-length binary) (n/+ 1 idx))
+ (if (n/< (..!size binary) (n/+ 1 idx))
(exec (|> binary
(host.array-write idx (..byte (i64.logical-right-shift 8 value)))
(host.array-write (n/+ 1 idx) (..byte value)))
(#error.Success binary))
- (ex.throw index-out-of-bounds (%n idx))))
+ (ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (write/32 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
- (if (n/< (host.array-length binary) (n/+ 3 idx))
+ (if (n/< (..!size binary) (n/+ 3 idx))
(exec (|> binary
(host.array-write idx (..byte (i64.logical-right-shift 24 value)))
(host.array-write (n/+ 1 idx) (..byte (i64.logical-right-shift 16 value)))
(host.array-write (n/+ 2 idx) (..byte (i64.logical-right-shift 8 value)))
(host.array-write (n/+ 3 idx) (..byte value)))
(#error.Success binary))
- (ex.throw index-out-of-bounds (%n idx))))
+ (ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (write/64 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
- (if (n/< (host.array-length binary) (n/+ 7 idx))
+ (if (n/< (..!size binary) (n/+ 7 idx))
(exec (|> binary
(host.array-write idx (..byte (i64.logical-right-shift 56 value)))
(host.array-write (n/+ 1 idx) (..byte (i64.logical-right-shift 48 value)))
@@ -125,29 +140,24 @@
(host.array-write (n/+ 6 idx) (..byte (i64.logical-right-shift 8 value)))
(host.array-write (n/+ 7 idx) (..byte value)))
(#error.Success binary))
- (ex.throw index-out-of-bounds (%n idx))))
-
-(def: #export (size binary)
- (-> Binary Nat)
- (host.array-length binary))
+ (ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (slice from to binary)
(-> Nat Nat Binary (Error Binary))
- (with-expansions [<description> (as-is (format "from = " (%n from) " | " "to = " (%n to)))]
- (let [size (host.array-length binary)]
- (cond (not (n/<= to from))
- (ex.throw inverted-range <description>)
+ (let [size (..!size binary)]
+ (cond (not (n/<= to from))
+ (ex.throw inverted-slice [size from to])
- (not (and (n/< size from)
- (n/< size to)))
- (ex.throw index-out-of-bounds <description>)
+ (not (and (n/< size from)
+ (n/< size to)))
+ (ex.throw slice-out-of-bounds [size from to])
- ## else
- (#error.Success (Arrays::copyOfRange binary (:coerce Int from) (:coerce Int (inc to))))))))
+ ## else
+ (#error.Success (Arrays::copyOfRange binary (:coerce Int from) (:coerce Int (inc to)))))))
(def: #export (slice' from binary)
(-> Nat Binary (Error Binary))
- (slice from (dec (host.array-length binary)) binary))
+ (slice from (dec (..!size binary)) binary))
(structure: #export _ (eq.Equivalence Binary)
(def: (= reference sample)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 14:29:27 +0000