Some small improvements and fixes.

11 files changed, 76 insertions, 56 deletions

diff --git a/luxc/src/lux/analyser/proc/jvm.clj b/luxc/src/lux/analyser/proc/jvm.clj
index 98c2435e9..9bcb9f616 100644
--- a/luxc/src/lux/analyser/proc/jvm.clj
+++ b/luxc/src/lux/analyser/proc/jvm.clj
@@ -729,7 +729,8 @@
                      super-params*))))
 
 (defn ^:private check-method! [only-interface? class method]
-  (|do [!class! (&/de-alias-class class)
+  (|do [!class!* (&/de-alias-class class)
+        :let [!class! (string/replace !class!* "/" ".")]
         class-loader &/loader
         _ (try (assert! (let [=class (Class/forName !class! true class-loader)]
                           (= only-interface? (.isInterface =class)))
@@ -737,7 +738,7 @@
                           (str "[Analyser Error] Can only invoke method \"" method "\"" " on interface.")
                           (str "[Analyser Error] Can only invoke method \"" method "\"" " on class.")))
             (catch Exception e
-              (&/fail-with-loc (str "[Analyser Error] Unknown class: " class))))]
+              (&/fail-with-loc (str "[Analyser Error] Unknown class: " !class!))))]
     (return (&/T [!class! class-loader]))))
 
 (let [dummy-type-param (&/$Primitive "java.lang.Object" &/$Nil)]
@@ -883,6 +884,7 @@
             :let [name (->> scope &/|reverse &/|tail &host/location)
                   class-decl (&/T [name &/$Nil])
                   anon-class (str (string/replace module "/" ".") "." name)
+                  class-type-decl (&/T [anon-class &/$Nil])
                   anon-class-type (&/$Primitive anon-class &/$Nil)]
             =ctor-args (&/map% (fn [ctor-arg]
                                  (|let [[arg-type arg-term] ctor-arg]
@@ -893,7 +895,7 @@
                    (&/$Cons default-<init>)
                    (&host/use-dummy-class class-decl super-class interfaces (&/$Some =ctor-args) &/$Nil))
             [=methods =captured] (let [all-supers (&/$Cons super-class interfaces)]
-                                   (analyse-methods analyse class-decl all-supers methods))
+                                   (analyse-methods analyse class-type-decl all-supers methods))
             _ (let [=fields (&/|map (fn [^objects idx+capt]
                                       (|let [[idx _] idx+capt]
                                         (&/$VariableFieldAnalysis (str &c!base/closure-prefix idx)
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"