From 2cfb7042e464a26a239e7b0f24cc28bd7781e520 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 26 Dec 2018 00:50:18 -0400 Subject: Some refactoring & minor additions. --- stdlib/source/lux/control/fold.lux | 14 ++++- stdlib/source/lux/control/monoid.lux | 8 +-- stdlib/source/lux/data/collection/array.lux | 4 +- stdlib/source/lux/data/collection/list.lux | 60 +++++++++++---------- stdlib/source/lux/data/collection/row.lux | 12 ++--- stdlib/source/lux/data/number/i64.lux | 16 ++++-- stdlib/source/lux/data/text.lux | 2 + stdlib/source/lux/host.jvm.lux | 2 +- stdlib/source/lux/type.lux | 6 +-- stdlib/source/lux/world/binary.lux | 84 ++++++++++++++++------------- 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 compose lL lR) (:: Monoid compose rL rR)]))) - -(def: #export (fold Monoid Fold data) - (All [a F] (-> (Monoid a) (Fold F) (F a) a)) - (let [(^open "a/.") Monoid] - (:: Fold 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 [ ] - [(def: #export ( p xs) + [(def: #export ( 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) )))] - [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 [ ] - [(def: #export ( p xs) + [(def: #export ( predicate xs) (All [a] - (-> (-> a Bit) (List a) Bit)) + (-> (Predicate a) (List a) Bit)) (loop [xs xs] (case xs #.Nil (#.Cons x xs') - (case (p x) + (case (predicate x) (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 (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] (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 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 [ ] [(def: #export ( param subject) {#.doc } - (All [s] (-> (I64 s) (I64 s) (I64 s))) + (All [s] (-> (I64 Any) (I64 s) (I64 s))) ( 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 [] + [(exception: #export ( {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 [ (as-is (format "from = " (%n from) " | " "to = " (%n to)))] - (let [size (host.array-length binary)] - (cond (not (n/<= to from)) - (ex.throw inverted-range ) + (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 ) + (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) -- cgit v1.2.3