Test to make sure modules cannot import themselves.

8 files changed, 508 insertions, 286 deletions

diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux
index 3c1bcc02d..fee6eba92 100644
--- a/stdlib/source/lux/data/bit.lux
+++ b/stdlib/source/lux/data/bit.lux
@@ -37,7 +37,9 @@
   [conjunction #1 and]
   )
 
-(structure: #export codec (Codec Text Bit)
+(structure: #export codec
+  (Codec Text Bit)
+  
   (def: (encode x)
     (if x
       "#1"
diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux
index 36b9fdf6d..4334e7f41 100644
--- a/stdlib/source/lux/data/color.lux
+++ b/stdlib/source/lux/data/color.lux
@@ -1,23 +1,24 @@
 (.module:
   [lux #*
    [abstract
-    [equivalence (#+ Equivalence)]]
+    [equivalence (#+ Equivalence)]
+    [monoid (#+ Monoid)]]
    [data
     [number
      ["n" nat]
      ["." int]
-     ["." rev ("#;." interval)]
+     ["." rev ("#@." interval)]
      ["f" frac]]
     [collection
-     ["." list ("#;." functor)]]]
+     ["." list ("#@." functor)]]]
    ["." math]
    [type
     abstract]])
 
-(def: rgb Nat 256)
-(def: top Nat (dec rgb))
+(def: rgb 256)
+(def: top (dec rgb))
 
-(def: rgb-factor Frac (|> top .int int.frac))
+(def: rgb-factor (|> top .int int.frac))
 
 (def: scale-down
   (-> Nat Frac)
@@ -49,21 +50,68 @@
 
   (def: #export (from-rgb [red green blue])
     (-> RGB Color)
-    (:abstraction {#red (n.% rgb red)
-                   #green (n.% rgb green)
-                   #blue (n.% rgb blue)}))
+    (:abstraction {#red (n.% ..rgb red)
+                   #green (n.% ..rgb green)
+                   #blue (n.% ..rgb blue)}))
 
   (def: #export to-rgb
     (-> Color RGB)
     (|>> :representation))
 
-  (structure: #export equivalence (Equivalence Color)
+  (structure: #export equivalence
+    (Equivalence Color)
+    
     (def: (= reference sample)
       (let [[rr rg rb] (:representation reference)
             [sr sg sb] (:representation sample)]
         (and (n.= rr sr)
              (n.= rg sg)
              (n.= rb sb)))))
+
+  (def: #export black
+    (..from-rgb {#red 0
+                 #green 0
+                 #blue 0}))
+
+  (def: #export white
+    (..from-rgb {#red ..top
+                 #green ..top
+                 #blue ..top}))
+
+  (structure: #export addition
+    (Monoid Color)
+
+    (def: identity ..black)
+
+    (def: (compose left right)
+      (let [[lR lG lB] (:representation left)
+            [rR rG rB] (:representation right)]
+        (:abstraction {#red (n.max lR rR)
+                       #green (n.max lG rG)
+                       #blue (n.max lB rB)}))))
+
+  (def: (complement' value)
+    (-> Nat Nat)
+    (|> ..top (n.- value)))
+
+  (def: #export (complement color)
+    (-> Color Color)
+    (let [[red green blue] (:representation color)]
+      (:abstraction {#red (complement' red)
+                     #green (complement' green)
+                     #blue (complement' blue)})))
+
+  (structure: #export subtraction
+    (Monoid Color)
+
+    (def: identity ..white)
+
+    (def: (compose left right)
+      (let [[lR lG lB] (:representation (..complement left))
+            [rR rG rB] (:representation right)]
+        (:abstraction {#red (n.min lR rR)
+                       #green (n.min lG rG)
+                       #blue (n.min lB rB)}))))
   )
 
 (def: #export (to-hsl color)
@@ -227,14 +275,14 @@
         (f.% +1.0 ratio)
 
         (f.< +0.0 ratio)
-        (|> +1.0 (f.+ (f.% +1.0 ratio)))
+        (|> ratio (f.% +1.0) (f.+ +1.0))
 
         ## else
         ratio))
 
 (def: #export (interpolate ratio end start)
   (-> Frac Color Color Color)
-  (let [dS (normalize ratio)
+  (let [dS (..normalize ratio)
         dE (|> +1.0 (f.- dS))
         interpolate' (: (-> Nat Nat Nat)
                         (function (_ end start)
@@ -248,37 +296,22 @@
                #green (interpolate' greenE greenS)
                #blue (interpolate' blueE blueS)})))
 
-(def: #export black (from-rgb {#red 0
-                               #green 0
-                               #blue 0}))
-(def: #export white (from-rgb {#red top
-                               #green top
-                               #blue top}))
-
 (template [<name> <target>]
   [(def: #export (<name> ratio color)
      (-> Frac Color Color)
-     (interpolate ratio <target> color))]
+     (..interpolate ratio <target> color))]
 
   [darker   black]
   [brighter white]
   )
 
-(def: #export (complement color)
-  (-> Color Color)
-  (let [[red green blue] (to-rgb color)
-        adjust (function (_ value) (|> top (n.- value)))]
-    (from-rgb {#red (adjust red)
-               #green (adjust green)
-               #blue (adjust blue)})))
-
 (template [<name> <op>]
   [(def: #export (<name> ratio color)
      (-> Frac Color Color)
      (let [[hue saturation luminance] (to-hsl color)]
        (from-hsl [hue
                   (|> saturation
-                      (f.* (|> +1.0 (<op> (normalize ratio))))
+                      (f.* (|> +1.0 (<op> (..normalize ratio))))
                       (f.min +1.0))
                   luminance])))]
 
@@ -298,10 +331,10 @@
      (-> Color [Color Color Color])
      (let [[hue saturation luminance] (to-hsl color)]
        [color
-        (from-hsl [(|> hue (f.+ <1>) normalize)
+        (from-hsl [(|> hue (f.+ <1>) ..normalize)
                    saturation
                    luminance])
-        (from-hsl [(|> hue (f.+ <2>) normalize)
+        (from-hsl [(|> hue (f.+ <2>) ..normalize)
                    saturation
                    luminance])]))]
 
@@ -313,15 +346,15 @@
 (template [<name> <1> <2> <3>]
   [(def: #export (<name> color)
      (-> Color [Color Color Color Color])
-     (let [[hue saturation luminance] (to-hsl color)]
+     (let [[hue saturation luminance] (to-hsb color)]
        [color
-        (from-hsl [(|> hue (f.+ <1>) normalize)
+        (from-hsb [(|> hue (f.+ <1>) ..normalize)
                    saturation
                    luminance])
-        (from-hsl [(|> hue (f.+ <2>) normalize)
+        (from-hsb [(|> hue (f.+ <2>) ..normalize)
                    saturation
                    luminance])
-        (from-hsl [(|> hue (f.+ <3>) normalize)
+        (from-hsb [(|> hue (f.+ <3>) ..normalize)
                    saturation
                    luminance])]))]
 
@@ -329,37 +362,40 @@
   [tetradic (|> +2.0 (f./ +12.0)) (|> +6.0 (f./ +12.0)) (|> +8.0 (f./ +12.0))]
   )
 
-(def: #export (analogous results slice color)
-  (-> Nat Frac Color (List Color))
-  (if (n.= 0 results)
-    (list)
-    (let [[hue saturation luminance] (to-hsl color)
-          slice (normalize slice)]
-      (list;map (function (_ idx)
-                  (from-hsl [(|> idx .int int.frac (f.* slice) (f.+ hue) normalize)
-                             saturation
-                             luminance]))
-                (list.indices results)))))
-
-(def: #export (monochromatic results color)
-  (-> Nat Color (List Color))
-  (if (n.= 0 results)
-    (list)
-    (let [[hue saturation brightness] (to-hsb color)
-          slice (|> +1.0 (f./ (|> results .int int.frac)))]
-      (|> (list.indices results)
-          (list;map (|>> .int int.frac
-                         (f.* slice)
-                         (f.+ brightness)
-                         normalize
-                         [hue saturation]
-                         from-hsb))))))
-
-(type: #export Alpha Rev)
+(type: #export Spread
+  Frac)
+
+(type: #export Palette
+  (-> Spread Nat Color (List Color)))
+
+(def: #export (analogous spread variations color)
+  (-> Spread Nat Color (List Color))
+  (let [[hue saturation brightness] (to-hsb color)
+        spread (..normalize spread)]
+    (list@map (function (_ idx)
+                (from-hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normalize)
+                           saturation
+                           brightness]))
+              (list.indices variations))))
+
+(def: #export (monochromatic spread variations color)
+  (-> Spread Nat Color (List Color))
+  (let [[hue saturation brightness] (to-hsb color)
+        spread (..normalize spread)]
+    (|> (list.indices variations)
+        (list@map (|>> inc .int int.frac
+                       (f.* spread)
+                       (f.+ brightness)
+                       ..normalize
+                       [hue saturation]
+                       from-hsb)))))
+
+(type: #export Alpha
+  Rev)
 
 (def: #export transparent
   Alpha
-  rev;bottom)
+  rev@bottom)
 
 (def: #export translucent
   Alpha
@@ -367,7 +403,7 @@
 
 (def: #export opaque
   Alpha
-  rev;top)
+  rev@top)
 
 (type: #export Pigment
   {#color Color
diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux
index 22a8e5372..47ad25f30 100644
--- a/stdlib/source/lux/data/number/frac.lux
+++ b/stdlib/source/lux/data/number/frac.lux
@@ -9,7 +9,8 @@
    [control
     ["." try (#+ Try)]]
    [data
-    ["." maybe]]
+    ["." maybe]
+    ["." text]]
    ["." math]]
   ["." // #_
    ["#." i64]
@@ -160,9 +161,14 @@
   (Codec Text Frac)
   
   (def: (encode x)
-    (if (..< +0.0 x)
-      ("lux f64 encode" x)
-      ("lux text concat" "+" ("lux f64 encode" x))))
+    (case x
+      -0.0 (let [output ("lux f64 encode" x)]
+             (if (text.starts-with? "-" output)
+               output
+               ("lux text concat" "+" output)))
+      _ (if (..< +0.0 x)
+          ("lux f64 encode" x)
+          ("lux text concat" "+" ("lux f64 encode" x)))))
 
   (def: (decode input)
     (case ("lux f64 decode" [input])
diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux
index 455176de6..aadd8199b 100644
--- a/stdlib/source/lux/time/date.lux
+++ b/stdlib/source/lux/time/date.lux
@@ -16,7 +16,7 @@
     ["." text ("#@." monoid)]
     [number
      ["n" nat ("#@." decimal)]
-     ["i" int ("#@." decimal)]]
+     ["i" int]]
     [collection
      ["." list ("#@." fold)]
      ["." dictionary (#+ Dictionary)]]]
@@ -53,21 +53,9 @@
    ["Value" (n@encode day)]
    ["Minimum" (n@encode ..minimum-day)]
    ["Maximum" (n@encode (..month-days year month))]
-   ["Year" (i@encode year)]
+   ["Year" (:: //year.codec encode year)]
    ["Month" (n@encode (//month.number month))]))
 
-(def: (internal-year year)
-  (-> Year Year)
-  (if (i.< +0 year)
-    (inc year)
-    year))
-
-(def: (external-year year)
-  (-> Year Year)
-  (if (i.> +0 year)
-    year
-    (dec year)))
-
 (def: (pad value)
   (-> Nat Text)
   (let [digits (n@encode value)]
@@ -85,25 +73,22 @@
 
   (def: #export (date year month day)
     (-> Year Month Nat (Try Date))
-    (case year
-      +0 (exception.throw ..there-is-no-year-0 [])
-      _ (let [year (..internal-year year)]
-          (if (..day-is-within-limits? year month day)
-            (#try.Success
-             (:abstraction
-              {#year year
-               #month month
-               #day day}))
-            (exception.throw ..invalid-day [year month day])))))
-
-  (template [<name> <type> <field> <post-processing>]
+    (if (..day-is-within-limits? year month day)
+      (#try.Success
+       (:abstraction
+        {#year year
+         #month month
+         #day day}))
+      (exception.throw ..invalid-day [year month day])))
+
+  (template [<name> <type> <field>]
     [(def: #export <name>
        (-> Date <type>)
-       (|>> :representation (get@ <field>) <post-processing>))]
+       (|>> :representation (get@ <field>)))]
 
-    [year Year #year ..external-year]
-    [month Month #month (|>)]
-    [day-of-month Nat #day (|>)]
+    [year Year #year]
+    [month Month #month]
+    [day-of-month Nat #day]
     )
 
   (structure: #export equivalence
@@ -112,8 +97,9 @@
     (def: (= reference sample)
       (let [reference (:representation reference)
             sample (:representation sample)]
-        (and (i.= (get@ #year reference)
-                  (get@ #year sample))
+        (and (:: //year.equivalence =
+                 (get@ #year reference)
+                 (get@ #year sample))
              (:: //month.equivalence =
                  (get@ #month reference)
                  (get@ #month sample))
@@ -128,10 +114,12 @@
     (def: (< reference sample)
       (let [reference (:representation reference)
             sample (:representation sample)]
-        (or (i.< (get@ #year reference)
-                 (get@ #year sample))
-            (and (i.= (get@ #year reference)
-                      (get@ #year sample))
+        (or (:: //year.order <
+                (get@ #year reference)
+                (get@ #year sample))
+            (and (:: //year.equivalence =
+                     (get@ #year reference)
+                     (get@ #year sample))
                  (or (:: //month.order <
                          (get@ #month reference)
                          (get@ #month sample))
@@ -142,16 +130,6 @@
                                (get@ #day sample)))))))))
   )
 
-(def: parse-year
-  (Parser Year)
-  (do {@ <>.monad}
-    [sign (<>.or (<t>.this "-") (wrap []))
-     digits (<t>.many <t>.decimal)
-     raw-year (<>.codec i.decimal (wrap (text@compose "+" digits)))]
-    (wrap (case sign
-            (#.Left _)  (i.* -1 raw-year)
-            (#.Right _) raw-year))))
-
 (def: parse-section
   (Parser Nat)
   (<>.codec n.decimal (<t>.exactly 2 <t>.decimal)))
@@ -185,7 +163,7 @@
 (def: #export parser
   (Parser Date)
   (do <>.monad
-    [utc-year ..parse-year
+    [utc-year //year.parser
      _ (<t>.this ..separator)
      utc-month ..parse-month
      _ (<t>.this ..separator)
@@ -195,13 +173,10 @@
 
 (def: (encode value)
   (-> Date Text)
-  (let [year (..year value)]
-    ($_ text@compose
-        (if (i.< +0 year)
-          (i@encode year)
-          (n@encode (.nat year)))
-        ..separator (..pad (|> value ..month //month.number))
-        ..separator (..pad (..day-of-month value)))))
+  ($_ text@compose
+      (:: //year.codec encode (..year value))
+      ..separator (..pad (|> value ..month //month.number))
+      ..separator (..pad (..day-of-month value))))
 
 (structure: #export codec
   {#.doc (doc "Based on ISO 8601."
@@ -292,7 +267,8 @@
 
 (def: (civil-year utc-month utc-year)
   (-> Nat Year Int)
-  (let [utc-year (..internal-year utc-year)]
+  (let [## Coercing, because the year is already in external form.
+        utc-year (:coerce Int utc-year)]
     (if (n.< ..first-month-of-civil-year utc-month)
       (dec utc-year)
       utc-year)))
@@ -349,6 +325,18 @@
         year (if (n.< ..first-month-of-civil-year month)
                (inc year)
                year)]
-    (try.assume (..date (..external-year year)
+    ## Coercing, because the year is already in internal form.
+    (try.assume (..date (:coerce Year year)
                         (maybe.assume (dictionary.get month ..month-by-number))
                         day))))
+
+(structure: #export enum
+  (Enum Date)
+
+  (def: &order ..order)
+
+  (def: succ
+    (|>> ..days inc ..from-days))
+
+  (def: pred
+    (|>> ..days dec ..from-days)))
diff --git a/stdlib/source/lux/time/year.lux b/stdlib/source/lux/time/year.lux
index 0ba2025c6..43e2181ab 100644
--- a/stdlib/source/lux/time/year.lux
+++ b/stdlib/source/lux/time/year.lux
@@ -1,19 +1,57 @@
 (.module:
   [lux #*
+   [abstract
+    [monad (#+ do)]
+    [codec (#+ Codec)]
+    [equivalence (#+ Equivalence)]
+    [order (#+ Order)]]
+   [control
+    ["." try (#+ Try)]
+    ["." exception (#+ exception:)]
+    ["<>" parser
+     ["<t>" text (#+ Parser)]]]
    [data
+    ["." text ("#@." monoid)]
     [number
-     ["n" nat]
-     ["i" int]]]])
+     ["n" nat ("#@." decimal)]
+     ["i" int ("#@." decimal)]]]
+   [type
+    abstract]])
 
-(type: #export Year
-  Int)
+(def: (internal year)
+  (-> Int Int)
+  (if (i.< +0 year)
+    (inc year)
+    year))
+
+(def: (external year)
+  (-> Int Int)
+  (if (i.> +0 year)
+    year
+    (dec year)))
+
+(exception: #export there-is-no-year-0)
+
+(abstract: #export Year
+  Int
+
+  (def: #export (year value)
+    (-> Int (Try Year))
+    (case value
+      +0 (exception.throw ..there-is-no-year-0 [])
+      _ (#try.Success (:abstraction (..internal value)))))
+
+  (def: #export value
+    (-> Year Int)
+    (|>> :representation ..external))
+  )
 
 (def: #export days
   365)
 
 (def: #export epoch
   Year
-  +1970)
+  (try.assume (..year +1970)))
 
 (type: #export Period
   Nat)
@@ -35,9 +73,10 @@
 ## https://en.wikipedia.org/wiki/Leap_year#Algorithm
 (def: #export (leap? year)
   (-> Year Bit)
-  (and (..divisible? (.int ..leap) year)
-       (or (not (..divisible? (.int ..century) year))
-           (..divisible? (.int ..era) year))))
+  (let [year (|> year ..value ..internal)]
+    (and (..divisible? (.int ..leap) year)
+         (or (not (..divisible? (.int ..century) year))
+             (..divisible? (.int ..era) year)))))
 
 (def: (with-year-0-leap year days)
   (let [after-year-0? (i.> +0 year)]
@@ -47,7 +86,8 @@
 
 (def: #export (leaps year)
   (-> Year Int)
-  (let [limit (if (i.> +0 year)
+  (let [year (|> year ..value ..internal)
+        limit (if (i.> +0 year)
                 (dec year)
                 (inc year))]
     (`` (|> +0
@@ -59,3 +99,42 @@
                   [i.+ ..era]
                   ))
             (..with-year-0-leap year)))))
+
+(def: (encode year)
+  (-> Year Text)
+  (let [year (..value year)]
+    (if (i.< +0 year)
+      (i@encode year)
+      (n@encode (.nat year)))))
+
+(def: #export parser
+  (Parser Year)
+  (do {@ <>.monad}
+    [sign (<>.or (<t>.this "-") (wrap []))
+     digits (<t>.many <t>.decimal)
+     raw-year (<>.codec i.decimal (wrap (text@compose "+" digits)))]
+    (<>.lift (..year (case sign
+                       (#.Left _)  (i.* -1 raw-year)
+                       (#.Right _) raw-year)))))
+
+(structure: #export codec
+  {#.doc (doc "Based on ISO 8601."
+              "For example: 2017")}
+  (Codec Text Year)
+  
+  (def: encode ..encode)
+  (def: decode (<t>.run ..parser)))
+
+(structure: #export equivalence
+  (Equivalence Year)
+
+  (def: (= reference subject)
+    (i.= (..value reference) (..value subject))))
+
+(structure: #export order
+  (Order Year)
+
+  (def: &equivalence ..equivalence)
+
+  (def: (< reference subject)
+    (i.< (..value reference) (..value subject))))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 0580372c1..2d005d450 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -6,6 +6,7 @@
     ["." monad (#+ Monad do)]]
    [control
     ["." try (#+ Try)]
+    ["." exception (#+ exception:)]
     [concurrency
      ["." promise (#+ Promise Resolver) ("#@." monad)]
      ["." stm (#+ Var STM)]]]
@@ -13,7 +14,7 @@
     ["." binary (#+ Binary)]
     ["." bit]
     ["." product]
-    ["." text
+    ["." text ("#@." equivalence)
      ["%" format (#+ format)]]
     [collection
      ["." dictionary (#+ Dictionary)]
@@ -362,6 +363,16 @@
           try.assume
           product.left))
 
+    (exception: #export (module-cannot-import-itself {module Module})
+      (exception.report
+       ["Module" (%.text module)]))
+
+    (def: (verify-no-self-import! module dependencies)
+      (-> Module (List Module) (Try Any))
+      (if (list.any? (text@= module) dependencies)
+        (exception.throw ..module-cannot-import-itself [module])
+        (#try.Success [])))
+
     (def: #export (compile import static expander platform compilation context)
       (All [<type-vars>]
         (-> Import Static Expander <Platform> Compilation <Context> <Return>))
@@ -371,75 +382,75 @@
                                    context}
                                   {(///.Compiler <State+> .Module Any)
                                    (:assume
-                                    ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))})]
-        (do (try.with promise.monad)
-          [#let [compiler (..parallel
-                           context
-                           (function (_ import! module-id [archive state] module)
-                             (do (try.with promise.monad)
-                               [#let [state (..set-current-module module state)]
-                                input (context.read (get@ #&file-system platform)
-                                                    import
-                                                    compilation-sources
-                                                    (get@ #static.host-module-extension static)
-                                                    module)]
-                               (loop [[archive state] [archive state]
-                                      compilation (base-compiler (:coerce ///.Input input))
-                                      all-dependencies (: (List Module)
-                                                          (list))]
-                                 (do {@ (try.with promise.monad)}
-                                   [#let [new-dependencies (get@ #///.dependencies compilation)
-                                          all-dependencies (list@compose new-dependencies all-dependencies)
-                                          continue! (:share [<type-vars>]
-                                                            {<Platform>
-                                                             platform}
-                                                            {(-> <Context> (///.Compilation <State+> .Module Any) (List Module)
-                                                                 (Action [Archive <State+>]))
-                                                             (:assume
-                                                              recur)})]
-                                    [archive state] (case new-dependencies
-                                                      #.Nil
-                                                      (wrap [archive state])
+                                    ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))})
+            compiler (..parallel
+                      context
+                      (function (_ import! module-id [archive state] module)
+                        (do {@ (try.with promise.monad)}
+                          [#let [state (..set-current-module module state)]
+                           input (context.read (get@ #&file-system platform)
+                                               import
+                                               compilation-sources
+                                               (get@ #static.host-module-extension static)
+                                               module)]
+                          (loop [[archive state] [archive state]
+                                 compilation (base-compiler (:coerce ///.Input input))
+                                 all-dependencies (: (List Module)
+                                                     (list))]
+                            (let [new-dependencies (get@ #///.dependencies compilation)
+                                  all-dependencies (list@compose new-dependencies all-dependencies)
+                                  continue! (:share [<type-vars>]
+                                                    {<Platform>
+                                                     platform}
+                                                    {(-> <Context> (///.Compilation <State+> .Module Any) (List Module)
+                                                         (Action [Archive <State+>]))
+                                                     (:assume
+                                                      recur)})]
+                              (do @
+                                [[archive state] (case new-dependencies
+                                                   #.Nil
+                                                   (wrap [archive state])
 
-                                                      (#.Cons _)
-                                                      (do @
-                                                        [archive,document+ (|> new-dependencies
-                                                                               (list@map import!)
-                                                                               (monad.seq ..monad))
-                                                         #let [archive (|> archive,document+
-                                                                           (list@map product.left)
-                                                                           (list@fold archive.merge archive))]]
-                                                        (wrap [archive (try.assume
-                                                                        (..updated-state archive state))])))]
-                                   (case ((get@ #///.process compilation)
-                                          ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP.
-                                          ## TODO: The context shouldn't need to be re-set either.
-                                          (|> (///directive.set-current-module module)
-                                              (///phase.run' state)
-                                              try.assume
-                                              product.left)
-                                          archive)
-                                     (#try.Success [state more|done])
-                                     (case more|done
-                                       (#.Left more)
-                                       (continue! [archive state] more all-dependencies)
+                                                   (#.Cons _)
+                                                   (do @
+                                                     [_ (:: promise.monad wrap (verify-no-self-import! module new-dependencies))
+                                                      archive,document+ (|> new-dependencies
+                                                                            (list@map import!)
+                                                                            (monad.seq ..monad))
+                                                      #let [archive (|> archive,document+
+                                                                        (list@map product.left)
+                                                                        (list@fold archive.merge archive))]]
+                                                     (wrap [archive (try.assume
+                                                                     (..updated-state archive state))])))]
+                                (case ((get@ #///.process compilation)
+                                       ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP.
+                                       ## TODO: The context shouldn't need to be re-set either.
+                                       (|> (///directive.set-current-module module)
+                                           (///phase.run' state)
+                                           try.assume
+                                           product.left)
+                                       archive)
+                                  (#try.Success [state more|done])
+                                  (case more|done
+                                    (#.Left more)
+                                    (continue! [archive state] more all-dependencies)
 
-                                       (#.Right [[descriptor document] output])
-                                       (do (try.with promise.monad)
-                                         [#let [_ (log! (..module-compilation-log state))
-                                                descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
-                                          _ (..cache-module static platform module-id [[descriptor document] output])]
-                                         (case (archive.add module [descriptor document] archive)
-                                           (#try.Success archive)
-                                           (wrap [archive
-                                                  (..with-reset-log state)])
-                                           
-                                           (#try.Failure error)
-                                           (promise@wrap (#try.Failure error)))))
+                                    (#.Right [[descriptor document] output])
+                                    (do @
+                                      [#let [_ (log! (..module-compilation-log state))
+                                             descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
+                                       _ (..cache-module static platform module-id [[descriptor document] output])]
+                                      (case (archive.add module [descriptor document] archive)
+                                        (#try.Success archive)
+                                        (wrap [archive
+                                               (..with-reset-log state)])
+                                        
+                                        (#try.Failure error)
+                                        (promise@wrap (#try.Failure error)))))
 
-                                     (#try.Failure error)
-                                     (do (try.with promise.monad)
-                                       [_ (ioW.freeze (get@ #&file-system platform) static archive)]
-                                       (promise@wrap (#try.Failure error)))))))))]]
-          (compiler compilation-module))))
+                                  (#try.Failure error)
+                                  (do @
+                                    [_ (ioW.freeze (get@ #&file-system platform) static archive)]
+                                    (promise@wrap (#try.Failure error))))))))))]
+        (compiler compilation-module)))
     ))
diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux
index 6f281818d..0be42e466 100644
--- a/stdlib/source/test/lux/data/bit.lux
+++ b/stdlib/source/test/lux/data/bit.lux
@@ -1,8 +1,8 @@
 (.module:
   [lux #*
-   ["%" data/text/format (#+ format)]
    ["_" test (#+ Test)]
-   ["r" math/random]
+   [math
+    ["." random]]
    [abstract
     [monad (#+ do)]
     {[0 #spec]
@@ -17,21 +17,20 @@
 
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of .Bit)))
-      (do r.monad
-        [value r.bit]
+  (<| (_.covering /._)
+      (do random.monad
+        [value random.bit]
         ($_ _.and
-            ($equivalence.spec /.equivalence r.bit)
-            ($codec.spec /.equivalence /.codec r.bit)
-            (<| (_.context "Disjunction.")
-                ($monoid.spec /.equivalence /.disjunction r.bit))
-            (<| (_.context "Conjunction.")
-                ($monoid.spec /.equivalence /.conjunction r.bit))
-            (_.test "A value cannot be true and false at the same time."
-                    (not (and value (not value))))
-            (_.test "A value must be either true or false at any time."
-                    (or value (not value)))
-            (_.test "Can create the complement of a predicate."
-                    (and (not (:: /.equivalence = value ((/.complement function.identity) value)))
-                         (:: /.equivalence = value ((/.complement not) value))))
+            (_.with-cover [/.equivalence]
+              ($equivalence.spec /.equivalence random.bit))
+            (_.with-cover [/.disjunction]
+              ($monoid.spec /.equivalence /.disjunction random.bit))
+            (_.with-cover [/.conjunction]
+              ($monoid.spec /.equivalence /.conjunction random.bit))
+            (_.with-cover [/.codec]
+              ($codec.spec /.equivalence /.codec random.bit))
+            
+            (_.cover [/.complement]
+                     (and (not (:: /.equivalence = value ((/.complement function.identity) value)))
+                          (:: /.equivalence = value ((/.complement not) value))))
             ))))
diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux
index a7b5c0088..388b49d93 100644
--- a/stdlib/source/test/lux/data/color.lux
+++ b/stdlib/source/test/lux/data/color.lux
@@ -5,41 +5,53 @@
     [monad (#+ do)]
     {[0 #spec]
      [/
-      ["$." equivalence]]}]
+      ["$." equivalence]
+      ["$." monoid]]}]
    [data
-    ["%" text/format (#+ format)]
     [number
+     ["n" nat]
      ["." int]
-     ["f" frac]]]
+     ["f" frac]
+     ["r" rev]]
+    [collection
+     ["." list]]]
+   [macro
+    ["." template]]
    ["." math
-    ["r" random (#+ Random)]]]
+    ["." random (#+ Random)]]]
   {1
-   ["." / (#+ Color)]})
+   ["." / (#+ Color)
+    ["." named]]})
 
 (def: #export color
   (Random Color)
-  (|> ($_ r.and r.nat r.nat r.nat)
-      (:: r.monad map /.from-rgb)))
+  (|> ($_ random.and random.nat random.nat random.nat)
+      (:: random.monad map /.from-rgb)))
 
 (def: scale
   (-> Nat Frac)
   (|>> .int int.frac))
 
 (def: square (-> Frac Frac) (math.pow +2.0))
+(def: square-root (-> Frac Frac) (math.pow +0.5))
 
-(def: (distance from to)
+(def: (distance/1 from to)
+  (-> Frac Frac Frac)
+  (square-root
+   (square
+    (f.- from to))))
+
+(def: (distance/3 from to)
   (-> Color Color Frac)
   (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)
-                       (|> (scale tb) (f.- (scale fb)) square)))))
-
-(def: error-margin Frac +1.8)
+    (square-root
+     ($_ f.+
+         (|> (scale tr) (f.- (scale fr)) square)
+         (|> (scale tg) (f.- (scale fg)) square)
+         (|> (scale tb) (f.- (scale fb)) square)))))
 
-(def: black (/.from-rgb [0 0 0]))
-(def: white (/.from-rgb [255 255 255]))
+(def: rgb-error-margin +1.8)
 
 (template [<field>]
   [(def: (<field> color)
@@ -51,56 +63,145 @@
   [luminance]
   )
 
+(def: (encoding expected)
+  (-> /.Color Test)
+  ($_ _.and
+      (_.cover [/.RGB /.to-rgb /.from-rgb]
+               (|> expected /.to-rgb /.from-rgb
+                   (:: /.equivalence = expected)))
+      (_.cover [/.HSL /.to-hsl /.from-hsl]
+               (|> expected /.to-hsl /.from-hsl
+                   (distance/3 expected)
+                   (f.<= ..rgb-error-margin)))
+      (_.cover [/.HSB /.to-hsb /.from-hsb]
+               (|> expected /.to-hsb /.from-hsb
+                   (distance/3 expected)
+                   (f.<= ..rgb-error-margin)))
+      (_.cover [/.CMYK /.to-cmyk /.from-cmyk]
+               (|> expected /.to-cmyk /.from-cmyk
+                   (distance/3 expected)
+                   (f.<= ..rgb-error-margin)))
+      ))
+
+(def: transformation
+  Test
+  (do random.monad
+    [colorful (|> ..color
+                  (random.filter (function (_ color) (|> (distance/3 color /.black) (f.>= +100.0))))
+                  (random.filter (function (_ color) (|> (distance/3 color /.white) (f.>= +100.0)))))
+     mediocre (|> ..color
+                  (random.filter (|>> saturation
+                                      ((function (_ saturation)
+                                         (and (f.>= +0.25 saturation)
+                                              (f.<= +0.75 saturation)))))))
+     ratio (|> random.safe-frac (random.filter (f.>= +0.5)))]
+    ($_ _.and
+        (_.cover [/.darker /.brighter]
+                 (and (f.<= (distance/3 colorful /.black)
+                            (distance/3 (/.darker ratio colorful) /.black))
+                      (f.<= (distance/3 colorful /.white)
+                            (distance/3 (/.brighter ratio colorful) /.white))))
+        (_.cover [/.interpolate]
+                 (and (f.<= (distance/3 colorful /.black)
+                            (distance/3 (/.interpolate ratio /.black colorful) /.black))
+                      (f.<= (distance/3 colorful /.white)
+                            (distance/3 (/.interpolate ratio /.white colorful) /.white))))
+        (_.cover [/.saturate]
+                 (f.> (saturation mediocre)
+                      (saturation (/.saturate ratio mediocre))))
+        (_.cover [/.de-saturate]
+                 (f.< (saturation mediocre)
+                      (saturation (/.de-saturate ratio mediocre))))
+        (_.cover [/.gray-scale]
+                 (let [gray'ed (/.gray-scale mediocre)]
+                   (and (f.= +0.0
+                             (saturation gray'ed))
+                        (|> (luminance gray'ed)
+                            (f.- (luminance mediocre))
+                            f.abs
+                            (f.<= ..rgb-error-margin)))))
+        )))
+
+(def: palette
+  Test
+  (_.with-cover [/.Spread /.Palette]
+    (do {@ random.monad}
+      [eH (:: @ map (|>> f.abs (f.% +0.9) (f.+ +0.05))
+              random.safe-frac)
+       #let [eS +0.5]
+       variations (:: @ map (|>> (n.% 3) (n.+ 2)) random.nat)
+       #let [max-spread (f./ (|> variations inc .int int.frac)
+                             +1.0)
+             min-spread (f./ +2.0 max-spread)
+             spread-space (f.- min-spread max-spread)]
+       spread (:: @ map (|>> f.abs (f.% spread-space) (f.+ min-spread))
+                  random.safe-frac)]
+      (`` ($_ _.and
+              (~~ (template [<brightness> <palette>]
+                    [(_.cover [<palette>]
+                              (let [eB <brightness>
+                                    expected (/.from-hsb [eH eS eB])
+                                    palette (<palette> spread variations expected)]
+                                (and (n.= variations (list.size palette))
+                                     (not (list.any? (:: /.equivalence = expected) palette)))))]
+                    [+1.0 /.analogous]
+                    [+0.5 /.monochromatic]
+                    ))
+              (~~ (template [<palette>]
+                    [(_.cover [<palette>]
+                              (let [expected (/.from-hsb [eH eS +0.5])
+                                    [c0 c1 c2] (<palette> expected)]
+                                (and (:: /.equivalence = expected c0)
+                                     (not (:: /.equivalence = expected c1))
+                                     (not (:: /.equivalence = expected c2)))))]
+
+                    [/.triad]
+                    [/.clash]
+                    [/.split-complement]))
+              (~~ (template [<palette>]
+                    [(_.cover [<palette>]
+                              (let [expected (/.from-hsb [eH eS +0.5])
+                                    [c0 c1 c2 c3] (<palette> expected)]
+                                (and (:: /.equivalence = expected c0)
+                                     (not (:: /.equivalence = expected c1))
+                                     (not (:: /.equivalence = expected c2))
+                                     (not (:: /.equivalence = expected c3)))))]
+
+                    [/.square]
+                    [/.tetradic]))
+              )))))
+
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /._)))
-      (do r.monad
-        [any ..color
-         colorful (|> color
-                      (r.filter (function (_ color) (|> (distance color black) (f.>= +100.0))))
-                      (r.filter (function (_ color) (|> (distance color white) (f.>= +100.0)))))
-         mediocre (|> color
-                      (r.filter (|>> saturation
-                                     ((function (_ saturation)
-                                        (and (f.>= +0.25 saturation)
-                                             (f.<= +0.75 saturation)))))))
-         ratio (|> r.safe-frac (r.filter (f.>= +0.5)))]
+  (<| (_.covering /._)
+      (_.with-cover [/.Color])
+      (do {@ random.monad}
+        [expected ..color]
         ($_ _.and
-            ($equivalence.spec /.equivalence ..color)
-            (_.test "Can convert to/from HSL."
-                    (|> any /.to-hsl /.from-hsl
-                        (distance any)
-                        (f.<= error-margin)))
-            (_.test "Can convert to/from HSB."
-                    (|> any /.to-hsb /.from-hsb
-                        (distance any)
-                        (f.<= error-margin)))
-            (_.test "Can convert to/from CMYK."
-                    (|> any /.to-cmyk /.from-cmyk
-                        (distance any)
-                        (f.<= error-margin)))
-            (_.test "Can interpolate between 2 colors."
-                    (and (f.<= (distance colorful black)
-                               (distance (/.darker ratio colorful) black))
-                         (f.<= (distance colorful white)
-                               (distance (/.brighter ratio colorful) white))))
-            (_.test "Can calculate complement."
-                    (let [~any (/.complement any)
-                          (^open "/@.") /.equivalence]
-                      (and (not (/@= any ~any))
-                           (/@= any (/.complement ~any)))))
-            (_.test "Can saturate color."
-                    (f.> (saturation mediocre)
-                         (saturation (/.saturate ratio mediocre))))
-            (_.test "Can de-saturate color."
-                    (f.< (saturation mediocre)
-                         (saturation (/.de-saturate ratio mediocre))))
-            (_.test "Can gray-scale color."
-                    (let [gray'ed (/.gray-scale mediocre)]
-                      (and (f.= +0.0
-                                (saturation gray'ed))
-                           (|> (luminance gray'ed)
-                               (f.- (luminance mediocre))
-                               f.abs
-                               (f.<= error-margin)))))
+            (_.with-cover [/.equivalence]
+              ($equivalence.spec /.equivalence ..color))
+            (_.with-cover [/.addition]
+              ($monoid.spec /.equivalence /.addition ..color))
+            (_.with-cover [/.subtraction]
+              ($monoid.spec /.equivalence /.addition ..color))
+            
+            (..encoding expected)
+            (_.cover [/.complement]
+                     (let [~expected (/.complement expected)
+                           (^open "/@.") /.equivalence]
+                       (and (not (/@= expected ~expected))
+                            (/@= expected (/.complement ~expected)))))
+            (_.cover [/.black /.white]
+                     (and (:: /.equivalence = /.white (/.complement /.black))
+                          (:: /.equivalence = /.black (/.complement /.white))))
+            ..transformation
+            ..palette
+            (_.with-cover [/.Alpha /.Pigment]
+              ($_ _.and
+                  (_.cover [/.transparent /.opaque]
+                           (and (r.= /.opaque (dec /.transparent))
+                                (r.= /.transparent (inc /.opaque))))
+                  (_.cover [/.translucent]
+                           (r.= /.transparent (r.+ /.translucent /.translucent)))
+                  ))
             ))))