aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2019-07-24 20:25:55 -0400
committerEduardo Julian2019-07-24 20:25:55 -0400
commite87fba1b7204ee611dcb5528b8a8a3716588c976 (patch)
tree77420205b2617c189a26af573b341771bf361b59 /stdlib
parentedcc0a2433722d09e7b1ef7922e7fa1f51e7fc15 (diff)
Small improvements here and there.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/abstract/hash.lux13
-rw-r--r--stdlib/source/lux/control/parser/binary.lux45
-rw-r--r--stdlib/source/lux/data/format/binary.lux4
-rw-r--r--stdlib/source/lux/data/maybe.lux8
-rw-r--r--stdlib/source/lux/data/number/frac.lux8
-rw-r--r--stdlib/source/lux/data/text.lux18
-rw-r--r--stdlib/source/lux/math/random.lux8
-rw-r--r--stdlib/source/lux/world/input/keyboard.lux145
-rw-r--r--stdlib/source/test/lux/data/number/frac.lux5
9 files changed, 142 insertions, 112 deletions
diff --git a/stdlib/source/lux/abstract/hash.lux b/stdlib/source/lux/abstract/hash.lux
index d2dee3bcb..752227fb7 100644
--- a/stdlib/source/lux/abstract/hash.lux
+++ b/stdlib/source/lux/abstract/hash.lux
@@ -1,9 +1,8 @@
(.module:
lux
[//
- [equivalence (#+ Equivalence)]])
+ ["." equivalence (#+ Equivalence)]])
-## [Signatures]
(signature: #export (Hash a)
{#.doc (doc "A way to produce hash-codes for a type's instances."
"A necessity when working with some data-structures, such as dictionaries or sets.")}
@@ -11,3 +10,13 @@
&equivalence)
(: (-> a Nat)
hash))
+
+(def: #export (product leftH rightH)
+ (All [l r] (-> (Hash l) (Hash r) (Hash [l r])))
+ (structure
+ (def: &equivalence
+ (equivalence.product (:: leftH &equivalence)
+ (:: rightH &equivalence)))
+ (def: (hash [leftV rightV])
+ (n/* (:: leftH hash leftV)
+ (:: rightH hash rightV)))))
diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux
index 8d01d2d48..2912e0a52 100644
--- a/stdlib/source/lux/control/parser/binary.lux
+++ b/stdlib/source/lux/control/parser/binary.lux
@@ -48,7 +48,7 @@
(template [<name> <size> <read>]
[(def: #export <name>
- (Parser (I64 Any))
+ (Parser I64)
(function (_ [offset binary])
(case (<read> offset binary)
(#try.Success data)
@@ -63,6 +63,18 @@
[bits/64 ..size/64 binary.read/64]
)
+(template [<name> <type>]
+ [(def: #export <name> (Parser <type>) ..bits/64)]
+
+ [nat Nat]
+ [int Int]
+ [rev Rev]
+ )
+
+(def: #export frac
+ (Parser Frac)
+ (//@map frac.from-bits ..bits/64))
+
(exception: #export (invalid-tag {range Nat} {byte Nat})
(exception.report
["Range" (%.nat range)]
@@ -71,11 +83,11 @@
(def: #export (or left right)
(All [l r] (-> (Parser l) (Parser r) (Parser (| l r))))
(do //.monad
- [flag bits/8]
+ [flag ..nat]
(case flag
0 (:: @ map (|>> #.Left) left)
1 (:: @ map (|>> #.Right) right)
- _ (//.lift (exception.throw ..invalid-tag [2 (.nat flag)])))))
+ _ (//.lift (exception.throw ..invalid-tag [2 flag])))))
(def: #export (rec body)
(All [a] (-> (-> (Parser a) (Parser a)) (Parser a)))
@@ -89,28 +101,11 @@
(def: #export bit
(Parser Bit)
- (function (_ [offset binary])
- (case (binary.read/8 offset binary)
- (#try.Success data)
- (case (: Nat data)
- (^template [<nat> <bit>]
- <nat> (#try.Success [(inc offset) binary] <bit>))
- ([0 #0]
- [1 #1])
-
- _
- (exception.throw ..invalid-tag [2 data]))
-
- (#try.Failure error)
- (#try.Failure error))))
-
-(def: #export nat (Parser Nat) (//@map .nat ..bits/64))
-(def: #export int (Parser Int) (//@map .int ..bits/64))
-(def: #export rev (Parser Rev) (//@map .rev ..bits/64))
-
-(def: #export frac
- (Parser Frac)
- (//@map frac.bits-to-frac ..bits/64))
+ (do //.monad
+ [choice (..or ..any ..any)]
+ (wrap (case choice
+ (#.Left _) #0
+ (#.Right _) #1))))
(template [<name> <bits> <size>]
[(def: #export <name>
diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux
index a947de559..58ea7eb05 100644
--- a/stdlib/source/lux/data/format/binary.lux
+++ b/stdlib/source/lux/data/format/binary.lux
@@ -127,7 +127,7 @@
try.assume)])]))
(template [<name> <type>]
- [(def: #export <name> (Writer <type>) (|>> .i64 ..bits/64))]
+ [(def: #export <name> (Writer <type>) ..bits/64)]
[nat Nat]
[int Int]
@@ -136,7 +136,7 @@
(def: #export frac
(Writer Frac)
- (|>> frac.frac-to-bits ..bits/64))
+ (|>> frac.to-bits ..bits/64))
(template [<name> <bits> <size> <write>]
[(def: #export <name>
diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux
index b96e014b3..3ba5e87e9 100644
--- a/stdlib/source/lux/data/maybe.lux
+++ b/stdlib/source/lux/data/maybe.lux
@@ -2,10 +2,10 @@
[lux #*
[abstract
[monoid (#+ Monoid)]
- ["." functor (#+ Functor)]
+ [equivalence (#+ Equivalence)]
[apply (#+ Apply)]
- ["." monad (#+ Monad do)]
- [equivalence (#+ Equivalence)]]])
+ ["." functor (#+ Functor)]
+ ["." monad (#+ Monad do)]]])
## (type: (Maybe a)
## #.None
@@ -111,4 +111,4 @@
(def: #export assume
(All [a] (-> (Maybe a) a))
- (|>> (default (undefined))))
+ (|>> (..default (undefined))))
diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux
index a23c5c4e2..6fb8f3831 100644
--- a/stdlib/source/lux/data/number/frac.lux
+++ b/stdlib/source/lux/data/number/frac.lux
@@ -343,7 +343,7 @@
["7FF" special-exponent-bits]
)
-(def: #export (frac-to-bits input)
+(def: #export (to-bits input)
(-> Frac I64)
(i64 (cond (not-a-number? input)
..not-a-number-bits
@@ -392,8 +392,8 @@
[sign sign-mask 1 (n/+ exponent-size mantissa-size)]
)
-(def: #export (bits-to-frac input)
- (-> (I64 Any) Frac)
+(def: #export (from-bits input)
+ (-> I64 Frac)
(let [S (sign input)
E (exponent input)
M (mantissa input)]
@@ -424,4 +424,4 @@
(structure: #export hash (Hash Frac)
(def: &equivalence ..equivalence)
- (def: hash frac-to-bits))
+ (def: hash ..to-bits))
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index ad5d49ae2..8a4b8a02a 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -27,15 +27,15 @@
[(def: #export <long> (from-code <code>))
(def: #export <short> <long>)]
- [00 \0 null]
- [07 \a alarm]
- [08 \b back-space]
- [09 \t tab]
- [10 \n new-line]
- [11 \v vertical-tab]
- [12 \f form-feed]
- [13 \r carriage-return]
- [34 \' double-quote]
+ [00 \0 null]
+ [07 \a alarm]
+ [08 \b back-space]
+ [09 \t tab]
+ [10 \n new-line]
+ [11 \v vertical-tab]
+ [12 \f form-feed]
+ [13 \r carriage-return]
+ [34 \'' double-quote]
)
(def: #export (size x)
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index ef1ed3e37..1bdc9931a 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -111,7 +111,7 @@
(def: #export frac
(Random Frac)
- (:: ..monad map frac.bits-to-frac ..nat))
+ (:: ..monad map (|>> .i64 frac.from-bits) ..nat))
(def: #export safe-frac
(Random Frac)
@@ -276,14 +276,14 @@
(All [a] (-> PRNG (Random a) [PRNG a]))
(calc prng))
-(def: pcg-32-magic-mult Nat 6364136223846793005)
+(def: pcg-32-magic Nat 6364136223846793005)
-(def: #export (pcg-32 [inc seed])
+(def: #export (pcg-32 [increase seed])
{#.doc (doc "An implementation of the PCG32 algorithm."
"For more information, please see: http://www.pcg-random.org/")}
(-> [(I64 Any) (I64 Any)] PRNG)
(function (_ _)
- [(|> seed .nat (n/* pcg-32-magic-mult) ("lux i64 +" inc) [inc] pcg-32)
+ [(|> seed .nat (n/* ..pcg-32-magic) ("lux i64 +" increase) [increase] pcg-32)
(let [rot (|> seed .i64 (i64.logic-right-shift 59))]
(|> seed
(i64.logic-right-shift 18)
diff --git a/stdlib/source/lux/world/input/keyboard.lux b/stdlib/source/lux/world/input/keyboard.lux
index a918ba635..b6fdb06ee 100644
--- a/stdlib/source/lux/world/input/keyboard.lux
+++ b/stdlib/source/lux/world/input/keyboard.lux
@@ -6,73 +6,98 @@
(type: #export Key
Nat)
-(template [<name> <code>]
+(template [<code> <name>]
[(def: #export <name> Key <code>)]
- [caps-lock 20]
- [num-lock 144]
- [scroll-lock 145]
-
- [back-space 8]
- [enter 10]
+ [00008 back-space]
+ [00010 enter]
+ [00016 shift]
+ [00017 control]
+ [00018 alt]
+ [00020 caps-lock]
+ [00027 escape]
+ [00032 space]
+ [00033 page-up]
+ [00034 page-down]
+ [00035 end]
+ [00036 home]
- [shift 16]
- [control 17]
- [alt 18]
+ [00037 left]
+ [00038 up]
+ [00039 right]
+ [00040 down]
- [escape 27]
- [page-up 33]
- [page-down 34]
- [end 35]
- [home 36]
+ [00065 a]
+ [00066 b]
+ [00067 c]
+ [00068 d]
+ [00069 e]
+ [00070 f]
+ [00071 g]
+ [00072 h]
+ [00073 i]
+ [00074 j]
+ [00075 k]
+ [00076 l]
+ [00077 m]
+ [00078 n]
+ [00079 o]
+ [00080 p]
+ [00081 q]
+ [00082 r]
+ [00083 s]
+ [00084 t]
+ [00085 u]
+ [00086 v]
+ [00087 w]
+ [00088 x]
+ [00089 y]
+ [00090 z]
- [left 37]
- [up 38]
- [right 39]
- [down 40]
+ [00096 num-pad-0]
+ [00097 num-pad-1]
+ [00098 num-pad-2]
+ [00099 num-pad-3]
+ [00100 num-pad-4]
+ [00101 num-pad-5]
+ [00102 num-pad-6]
+ [00103 num-pad-7]
+ [00104 num-pad-8]
+ [00105 num-pad-9]
- [delete 127]
- [print-screen 154]
- [insert 155]
- [windows 524]
+ [00127 delete]
+ [00144 num-lock]
+ [00145 scroll-lock]
+ [00154 print-screen]
+ [00155 insert]
+ [00524 windows]
- [num-pad-0 96]
- [num-pad-1 97]
- [num-pad-2 98]
- [num-pad-3 99]
- [num-pad-4 100]
- [num-pad-5 101]
- [num-pad-6 102]
- [num-pad-7 103]
- [num-pad-8 104]
- [num-pad-9 105]
-
- [f1 112]
- [f2 113]
- [f3 114]
- [f4 115]
- [f5 116]
- [f6 117]
- [f7 118]
- [f8 119]
- [f9 120]
- [f10 121]
- [f11 122]
- [f12 123]
- [f13 61440]
- [f14 61441]
- [f15 61442]
- [f16 61443]
- [f17 61444]
- [f18 61445]
- [f19 61446]
- [f20 61447]
- [f21 61448]
- [f22 61449]
- [f23 61450]
- [f24 61451]
+ [00112 f1]
+ [00113 f2]
+ [00114 f3]
+ [00115 f4]
+ [00116 f5]
+ [00117 f6]
+ [00118 f7]
+ [00119 f8]
+ [00120 f9]
+ [00121 f10]
+ [00122 f11]
+ [00123 f12]
+ [61440 f13]
+ [61441 f14]
+ [61442 f15]
+ [61443 f16]
+ [61444 f17]
+ [61445 f18]
+ [61446 f19]
+ [61447 f20]
+ [61448 f21]
+ [61449 f22]
+ [61450 f23]
+ [61451 f24]
)
(type: #export Press
- {#input (Either Key Char)
- #pressed? Bit})
+ {#pressed? Bit
+ #input Key})
diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux
index e683fb134..9edc0f921 100644
--- a/stdlib/source/test/lux/data/number/frac.lux
+++ b/stdlib/source/test/lux/data/number/frac.lux
@@ -48,6 +48,7 @@
(hex "+dead,BE.EF"))))
(do r.monad
[sample gen-frac]
- (_.test (format (%.name (name-of /.frac-to-bits)) " " (%.name (name-of /.bits-to-frac)))
- (|> sample /.frac-to-bits /.bits-to-frac (f/= sample))))
+ (_.test (format (%.name (name-of /.to-bits))
+ " & " (%.name (name-of /.from-bits)))
+ (|> sample /.to-bits /.from-bits (f/= sample))))
)))))