From 27d0955180c137813af1dcc36fe4db0ab25d21a8 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 5 Aug 2018 01:57:38 -0400
Subject: Some small improvements and fixes.
---
stdlib/source/lux.lux | 6 +++--
stdlib/source/lux/control/pipe.lux | 8 +++++--
stdlib/source/lux/data/color.lux | 14 ++++++------
stdlib/source/lux/data/format/css.lux | 4 ++--
stdlib/source/lux/host.jvm.lux | 16 ++++++++-----
stdlib/source/lux/time/duration.lux | 42 ++++++++++++++++++++--------------
stdlib/source/lux/time/instant.lux | 18 +++++++--------
stdlib/test/test/lux/data/color.lux | 4 ++--
stdlib/test/test/lux/host.jvm.lux | 2 +-
stdlib/test/test/lux/time/duration.lux | 10 ++++----
10 files changed, 71 insertions(+), 53 deletions(-)
(limited to 'stdlib')
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 4f48518a1..793cf5a4d 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -5547,7 +5547,7 @@
["Text"])
(#Named _ type')
- type'
+ (flatten-alias type')
_
type))
@@ -5576,7 +5576,9 @@
(case token
[_ (#Identifier [def-prefix def-name])]
(if (text/= "" def-prefix)
- (:: Monad return token)
+ (do Monad
+ [current-module current-module-name]
+ (anti-quote-def [current-module def-name]))
(anti-quote-def [def-prefix def-name]))
(^template []
diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux
index c23723f6d..4895a4f66 100644
--- a/stdlib/source/lux/control/pipe.lux
+++ b/stdlib/source/lux/control/pipe.lux
@@ -53,8 +53,7 @@
[i/odd?] [(i/* +3)]
[(new> -1)])))}
(with-gensyms [g!temp]
- (wrap (list (` (with-expansions
- [(~ g!temp) (~ prev)]
+ (wrap (list (` (let [(~ g!temp) (~ prev)]
(cond (~+ (do list.Monad
[[test then] branches]
(list (` (|> (~ g!temp) (~+ test)))
@@ -66,6 +65,11 @@
[(new> (~+ else))]
(~ prev))))))
+(syntax: #export (when> test {then body^} prev)
+ (wrap (list (` (cond> [(new> (~ test))] [(~+ then)]
+ []
+ (~ prev))))))
+
(syntax: #export (loop> {test body^}
{then body^}
prev)
diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux
index 335b937dd..55624f29e 100644
--- a/stdlib/source/lux/data/color.lux
+++ b/stdlib/source/lux/data/color.lux
@@ -32,7 +32,7 @@
(n/% rgb green)
(n/% rgb blue)]))
- (def: #export unpack
+ (def: #export to-rgb
(-> Color [Nat Nat Nat])
(|>> :representation))
@@ -47,7 +47,7 @@
(def: #export (to-hsl color)
(-> Color [Frac Frac Frac])
- (let [[red green blue] (unpack color)
+ (let [[red green blue] (to-rgb color)
red (scale-down red)
green (scale-down green)
blue (scale-down blue)
@@ -115,7 +115,7 @@
(def: #export (to-hsb color)
(-> Color [Frac Frac Frac])
- (let [[red green blue] (unpack color)
+ (let [[red green blue] (to-rgb color)
red (scale-down red)
green (scale-down green)
blue (scale-down blue)
@@ -164,7 +164,7 @@
(def: #export (to-cmyk color)
(-> Color [Frac Frac Frac Frac])
- (let [[red green blue] (unpack color)
+ (let [[red green blue] (to-rgb color)
red (scale-down red)
green (scale-down green)
blue (scale-down blue)
@@ -210,8 +210,8 @@
(f/+ (|> end .int int-to-frac (f/* dE)))
frac-to-int
.nat)))
- [redS greenS blueS] (unpack start)
- [redE greenE blueE] (unpack end)]
+ [redS greenS blueS] (to-rgb start)
+ [redE greenE blueE] (to-rgb end)]
(color [(interpolate' redE redS)
(interpolate' greenE greenS)
(interpolate' blueE blueS)])))
@@ -230,7 +230,7 @@
(def: #export (complement color)
(-> Color Color)
- (let [[red green blue] (unpack color)
+ (let [[red green blue] (to-rgb color)
adjust (function (_ value) (|> top (n/- value)))]
(..color [(adjust red)
(adjust green)
diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux
index 133beac38..083195972 100644
--- a/stdlib/source/lux/data/format/css.lux
+++ b/stdlib/source/lux/data/format/css.lux
@@ -41,7 +41,7 @@
(def: #export (rgb color)
(-> Color Value)
- (let [[red green blue] (color.unpack color)]
+ (let [[red green blue] (color.to-rgb color)]
(format "rgb(" (|> red .int %i)
"," (|> green .int %i)
"," (|> blue .int %i)
@@ -49,7 +49,7 @@
(def: #export (rgba color alpha)
(-> Color Rev Value)
- (let [[red green blue] (color.unpack color)]
+ (let [[red green blue] (color.to-rgb color)]
(format "rgba(" (|> red .int %i)
"," (|> green .int %i)
"," (|> blue .int %i)
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index e7d28dd04..201c49094 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -621,7 +621,8 @@
(#StaticMethod strict? type-vars args return-type return-expr exs)
(make-static-method-parser params class-name method-name args)
- (^or (#VirtualMethod final? strict? type-vars args return-type return-expr exs) (#OverridenMethod strict? owner-class type-vars args return-type return-expr exs))
+ (^or (#VirtualMethod final? strict? type-vars args return-type return-expr exs)
+ (#OverridenMethod strict? owner-class type-vars args return-type return-expr exs))
(make-special-method-parser params class-name method-name args)
(#AbstractMethod type-vars args return-type exs)
@@ -630,7 +631,7 @@
(#NativeMethod type-vars args return-type exs)
(make-virtual-method-parser params class-name method-name args)))
-## Syntaxs
+## Syntaxes
(def: (full-class-name^ imports)
(-> Class-Imports (Syntax Text))
(do p.Monad
@@ -824,8 +825,8 @@
(def: (arg-decl^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax ArgDecl))
- (s.tuple (p.and s.local-identifier
- (generic-type^ imports type-vars))))
+ (s.record (p.and s.local-identifier
+ (generic-type^ imports type-vars))))
(def: (arg-decls^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax (List ArgDecl)))
@@ -833,7 +834,7 @@
(def: (constructor-arg^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax ConstructorArg))
- (s.tuple (p.and (generic-type^ imports type-vars) s.any)))
+ (s.record (p.and (generic-type^ imports type-vars) s.any)))
(def: (constructor-args^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax (List ConstructorArg)))
@@ -1211,7 +1212,10 @@
args (s.tuple (p.exactly (list.size arg-decls) s.any))
#let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ (list)))
arg-decls))]]
- (wrap (`' ((~ (code.text (format "jvm invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text.join-with "," arg-decls'))))
+ (wrap (`' ((~ (code.text (format "jvm invokespecial"
+ ":" (get@ #super-class-name super-class)
+ ":" name
+ ":" (text.join-with "," arg-decls'))))
(~' _jvm_this) (~+ args)))))))]
(with-parens
(spaced (list "override"
diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux
index d7b0abb24..d14ce451e 100644
--- a/stdlib/source/lux/time/duration.lux
+++ b/stdlib/source/lux/time/duration.lux
@@ -16,7 +16,7 @@
abstract]])
(abstract: #export Duration
- {#.doc "Durations have a resolution of milliseconds."}
+ {#.doc "Durations have a resolution of milli-seconds."}
Int
(def: #export from-millis
@@ -36,9 +36,16 @@
[frame i/%]
)
- (def: #export (scale scalar duration)
- (-> Int Duration Duration)
- (:abstraction (i/* scalar (:representation duration))))
+ (do-template [ ]
+ [(def: #export ( scalar duration)
+ (-> Int Duration Duration)
+ (:abstraction ( scalar (:representation duration))))]
+
+ [scale-up i/*]
+ [scale-down i//]
+ )
+
+ (def: #export inverse (scale-up -1))
(def: #export (query param subject)
(-> Duration Duration Int)
@@ -67,17 +74,18 @@
[positive? i/>]
[negative? i/<]
- [neutral? i/=])
+ [neutral? i/=]
+ )
)
(def: #export empty Duration (from-millis +0))
(def: #export milli Duration (from-millis +1))
-(def: #export second Duration (scale +1_000 milli))
-(def: #export minute Duration (scale +60 second))
-(def: #export hour Duration (scale +60 minute))
-(def: #export day Duration (scale +24 hour))
-(def: #export week Duration (scale +7 day))
-(def: #export normal-year Duration (scale +365 day))
+(def: #export second Duration (scale-up +1_000 milli))
+(def: #export minute Duration (scale-up +60 second))
+(def: #export hour Duration (scale-up +60 minute))
+(def: #export day Duration (scale-up +24 hour))
+(def: #export week Duration (scale-up +7 day))
+(def: #export normal-year Duration (scale-up +365 day))
(def: #export leap-year Duration (merge day normal-year))
(structure: #export _ (Monoid Duration)
@@ -94,7 +102,7 @@
(int/abs days)
days)
time-left (if signed?
- (scale -1 time-left)
+ (scale-up -1 time-left)
time-left)
[hours time-left] [(query hour time-left) (frame hour time-left)]
[minutes time-left] [(query minute time-left) (frame minute time-left)]
@@ -141,11 +149,11 @@
(and (i/>= +0 utc-millis)
(i/<= +999 utc-millis)))]
(wrap (|> empty
- (merge (scale (sign utc-day) day))
- (merge (scale (sign utc-hour) hour))
- (merge (scale (sign utc-minute) minute))
- (merge (scale (sign utc-second) second))
- (merge (scale (sign utc-millis) milli))))))
+ (merge (scale-up (sign utc-day) day))
+ (merge (scale-up (sign utc-hour) hour))
+ (merge (scale-up (sign utc-minute) minute))
+ (merge (scale-up (sign utc-second) second))
+ (merge (scale-up (sign utc-millis) milli))))))
(def: (decode input)
(-> Text (e.Error Duration))
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux
index d6c506218..64d4fe172 100644
--- a/stdlib/source/lux/time/instant.lux
+++ b/stdlib/source/lux/time/instant.lux
@@ -102,7 +102,7 @@
(if (i/= +0 (duration.query year time-left))
[reference time-left]
(if (duration/>= duration.empty time-left)
- (recur (inc reference) (duration.merge (duration.scale -1 year) time-left))
+ (recur (inc reference) (duration.merge (duration.scale-up -1 year) time-left))
(recur (dec reference) (duration.merge year time-left)))
))))
@@ -121,14 +121,14 @@
(-> (Row Nat) duration.Duration [Nat duration.Duration])
(if (duration/>= duration.empty time)
(row/fold (function (_ month-days [current-month time-left])
- (let [month-duration (duration.scale (.int month-days) duration.day)]
+ (let [month-duration (duration.scale-up (.int month-days) duration.day)]
(if (i/= +0 (duration.query month-duration time-left))
[current-month time-left]
- [(inc current-month) (duration.merge (duration.scale -1 month-duration) time-left)])))
+ [(inc current-month) (duration.merge (duration.scale-up -1 month-duration) time-left)])))
[0 time]
months)
(row/fold (function (_ month-days [current-month time-left])
- (let [month-duration (duration.scale (.int month-days) duration.day)]
+ (let [month-duration (duration.scale-up (.int month-days) duration.day)]
(if (i/= +0 (duration.query month-duration time-left))
[current-month time-left]
[(dec current-month) (duration.merge month-duration time-left)])))
@@ -293,11 +293,11 @@
(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))
- (shift (duration.scale utc-minute duration.minute))
- (shift (duration.scale utc-second duration.second))
- (shift (duration.scale utc-millis duration.milli))))))
+ (shift (duration.scale-up total-days duration.day))
+ (shift (duration.scale-up utc-hour duration.hour))
+ (shift (duration.scale-up utc-minute duration.minute))
+ (shift (duration.scale-up utc-second duration.second))
+ (shift (duration.scale-up utc-millis duration.milli))))))
(def: (decode input)
(-> Text (e.Error Instant))
diff --git a/stdlib/test/test/lux/data/color.lux b/stdlib/test/test/lux/data/color.lux
index 8932fad79..977ffcf01 100644
--- a/stdlib/test/test/lux/data/color.lux
+++ b/stdlib/test/test/lux/data/color.lux
@@ -22,8 +22,8 @@
(def: (distance from to)
(-> @.Color @.Color Frac)
- (let [[fr fg fb] (@.unpack from)
- [tr tg tb] (@.unpack to)]
+ (let [[fr fg fb] (@.to-rgb from)
+ [tr tg tb] (@.to-rgb to)]
(math.pow +0.5 ($_ f/+
(|> (scale tr) (f/- (scale fr)) square)
(|> (scale tg) (f/- (scale fg)) square)
diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux
index 49a229d11..8832bb3f6 100644
--- a/stdlib/test/test/lux/host.jvm.lux
+++ b/stdlib/test/test/lux/host.jvm.lux
@@ -31,7 +31,7 @@
(#private bar A)
(#private baz java/lang/Object)
## Methods
- (#public [] (new [value A]) []
+ (#public [] (new {value A}) []
(exec (:= ::foo #1)
(:= ::bar value)
(:= ::baz "")
diff --git a/stdlib/test/test/lux/time/duration.lux b/stdlib/test/test/lux/time/duration.lux
index 1231fb563..669af6b4c 100644
--- a/stdlib/test/test/lux/time/duration.lux
+++ b/stdlib/test/test/lux/time/duration.lux
@@ -51,13 +51,13 @@
#let [(^open "@/.") @.Order]]
($_ seq
(test "Can scale a duration."
- (|> sample (@.scale factor) (@.query sample) (i/= factor)))
+ (|> sample (@.scale-up factor) (@.query sample) (i/= factor)))
(test "Scaling a duration by one does not change it."
- (|> sample (@.scale +1) (@/= sample)))
+ (|> sample (@.scale-up +1) (@/= sample)))
(test "Merging with the empty duration changes nothing."
(|> sample (@.merge @.empty) (@/= sample)))
(test "Merging a duration with it's opposite yields an empty duration."
- (|> sample (@.merge (@.scale -1 sample)) (@/= @.empty)))
+ (|> sample (@.merge (@.scale-up -1 sample)) (@/= @.empty)))
(test "Can frame a duration in terms of another."
(cond (and (@.positive? frame) (@.positive? sample))
(|> sample (@.frame frame) (@/< frame))
@@ -68,9 +68,9 @@
(or (or (@.neutral? frame) (@.neutral? sample))
(|> sample
(@.frame frame)
- (@.scale -1)
+ (@.scale-up -1)
(@/< (if (@.negative? frame)
- (@.scale -1 frame)
+ (@.scale-up -1 frame)
frame))))))))))
(context: "Codec"
--
cgit v1.2.3