From e87fba1b7204ee611dcb5528b8a8a3716588c976 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 24 Jul 2019 20:25:55 -0400 Subject: Small improvements here and there. --- stdlib/source/lux/abstract/hash.lux | 13 ++- stdlib/source/lux/control/parser/binary.lux | 45 ++++----- stdlib/source/lux/data/format/binary.lux | 4 +- stdlib/source/lux/data/maybe.lux | 8 +- stdlib/source/lux/data/number/frac.lux | 8 +- stdlib/source/lux/data/text.lux | 18 ++-- stdlib/source/lux/math/random.lux | 8 +- stdlib/source/lux/world/input/keyboard.lux | 145 ++++++++++++++++------------ stdlib/source/test/lux/data/number/frac.lux | 5 +- 9 files changed, 142 insertions(+), 112 deletions(-) (limited to 'stdlib') 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 [ ] [(def: #export - (Parser (I64 Any)) + (Parser I64) (function (_ [offset binary]) (case ( offset binary) (#try.Success data) @@ -63,6 +63,18 @@ [bits/64 ..size/64 binary.read/64] ) +(template [ ] + [(def: #export (Parser ) ..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 [ ] - (#try.Success [(inc offset) binary] )) - ([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 [ ] [(def: #export 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 [ ] - [(def: #export (Writer ) (|>> .i64 ..bits/64))] + [(def: #export (Writer ) ..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 [ ] [(def: #export 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 (from-code )) (def: #export )] - [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 [ ] +(template [ ] [(def: #export Key )] - [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)))) ))))) -- cgit v1.2.3