diff options
author | Eduardo Julian | 2018-08-05 01:57:38 -0400 |
---|---|---|
committer | Eduardo Julian | 2018-08-05 01:57:38 -0400 |
commit | 27d0955180c137813af1dcc36fe4db0ab25d21a8 (patch) | |
tree | 404e99333fddc0091a24e541412c0d776136aaa1 /stdlib | |
parent | 221cf3ea1bd48a8c678d3447558ea94631114ebc (diff) |
Some small improvements and fixes.
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux.lux | 6 | ||||
-rw-r--r-- | stdlib/source/lux/control/pipe.lux | 8 | ||||
-rw-r--r-- | stdlib/source/lux/data/color.lux | 14 | ||||
-rw-r--r-- | stdlib/source/lux/data/format/css.lux | 4 | ||||
-rw-r--r-- | stdlib/source/lux/host.jvm.lux | 16 | ||||
-rw-r--r-- | stdlib/source/lux/time/duration.lux | 42 | ||||
-rw-r--r-- | stdlib/source/lux/time/instant.lux | 18 | ||||
-rw-r--r-- | stdlib/test/test/lux/data/color.lux | 4 | ||||
-rw-r--r-- | stdlib/test/test/lux/host.jvm.lux | 2 | ||||
-rw-r--r-- | stdlib/test/test/lux/time/duration.lux | 10 |
10 files changed, 71 insertions, 53 deletions
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<Meta> return token) + (do Monad<Meta> + [current-module current-module-name] + (anti-quote-def [current-module def-name])) (anti-quote-def [def-prefix def-name])) (^template [<tag>] 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<List> [[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<Parser> @@ -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 [<name> <op>] + [(def: #export (<name> scalar duration) + (-> Int Duration Duration) + (:abstraction (<op> 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<Duration>]] ($_ 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" |