Test imports for circular dependencies.

16 files changed, 1109 insertions, 429 deletions

diff --git a/stdlib/source/lux/data/env.lux b/stdlib/source/lux/data/env.lux
deleted file mode 100644
index 7e4265e6a..000000000
--- a/stdlib/source/lux/data/env.lux
+++ /dev/null
@@ -1,25 +0,0 @@
-(.module:
-  [lux #*
-   [abstract
-    [functor (#+ Functor)]
-    comonad]])
-
-(type: #export (Env e a)
-  {#env e
-   #value a})
-
-(structure: #export functor (All [e] (Functor (Env e)))
-  (def: (map f fa)
-    (update@ #value f fa)))
-
-(structure: #export comonad (All [e] (CoMonad (Env e)))
-  (def: &functor ..functor)
-
-  (def: unwrap (get@ #value))
-
-  (def: (split wa)
-    (set@ #value wa wa)))
-
-(def: #export (local change env)
-  (All [e a] (-> (-> e e) (Env e a) (Env e a)))
-  (update@ #env change env))
diff --git a/stdlib/source/lux/data/identity.lux b/stdlib/source/lux/data/identity.lux
index 412103987..ce0476d8a 100644
--- a/stdlib/source/lux/data/identity.lux
+++ b/stdlib/source/lux/data/identity.lux
@@ -11,20 +11,27 @@
 (type: #export (Identity a)
   a)
 
-(structure: #export functor (Functor Identity)
+(structure: #export functor
+  (Functor Identity)
+
   (def: map function.identity))
 
-(structure: #export apply (Apply Identity)
+(structure: #export apply
+  (Apply Identity)
+
   (def: &functor ..functor)
-  (def: (apply ff fa)
-    (ff fa)))
+  (def: (apply ff fa) (ff fa)))
 
-(structure: #export monad (Monad Identity)
+(structure: #export monad
+  (Monad Identity)
+  
   (def: &functor ..functor)
   (def: wrap function.identity)
   (def: join function.identity))
 
-(structure: #export comonad (CoMonad Identity)
+(structure: #export comonad
+  (CoMonad Identity)
+  
   (def: &functor ..functor)
   (def: unwrap function.identity)
   (def: split function.identity))
diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux
index e1c19c55d..c46b5bf1f 100644
--- a/stdlib/source/lux/target/jvm/bytecode.lux
+++ b/stdlib/source/lux/target/jvm/bytecode.lux
@@ -456,7 +456,11 @@
       (#try.Failure _)
       (..bytecode $0 $1 @_ _.ldc-w/string [index]))))
 
-(import: #long java/lang/Float)
+(import: #long java/lang/Float
+  (#static floatToRawIntBits #manual [float] int))
+
+(import: #long java/lang/Double
+  (#static doubleToRawLongBits #manual [double] int))
 
 (template [<name> <type> <constructor> <constant> <wide> <to-lux> <specializations>]
   [(def: #export (<name> value)
@@ -484,13 +488,42 @@
     [+3 _.iconst-3]
     [+4 _.iconst-4]
     [+5 _.iconst-5])]
-  [float java/lang/Float //constant.float //constant/pool.float _.ldc-w/float
-   (<| (:coerce Frac) host.float-to-double)
-   ([+0.0 _.fconst-0]
-    [+1.0 _.fconst-1]
-    [+2.0 _.fconst-2])]
   )
 
+(def: (arbitrary-float value)
+  (-> java/lang/Float (Bytecode Any))
+  (do ..monad
+    [index (..lift (//constant/pool.float (//constant.float value)))]
+    (case (|> index //index.value //unsigned.value //unsigned.u1)
+      (#try.Success index)
+      (..bytecode $0 $1 @_ _.ldc [index])
+
+      (#try.Failure _)
+      (..bytecode $0 $1 @_ _.ldc-w/float [index]))))
+
+(def: float-bits
+  (-> java/lang/Float Int)
+  (|>> java/lang/Float::floatToRawIntBits
+       host.int-to-long
+       (:coerce Int)))
+
+(def: negative-zero-float-bits
+  (|> -0.0 host.double-to-float ..float-bits))
+
+(def: #export (float value)
+  (-> java/lang/Float (Bytecode Any))
+  (if (i.= ..negative-zero-float-bits
+           (..float-bits value))
+    (..arbitrary-float value)
+    (case (|> value host.float-to-double (:coerce Frac))
+      (^template [<special> <instruction>]
+        <special> (..bytecode $0 $1 @_ <instruction> []))
+      ([+0.0 _.fconst-0]
+       [+1.0 _.fconst-1]
+       [+2.0 _.fconst-2])
+      
+      _ (..arbitrary-float value))))
+
 (template [<name> <type> <constructor> <constant> <wide> <to-lux> <specializations>]
   [(def: #export (<name> value)
      (-> <type> (Bytecode Any))
@@ -507,12 +540,35 @@
    (<|)
    ([+0 _.lconst-0]
     [+1 _.lconst-1])]
-  [double Frac //constant.double //constant/pool.double _.ldc2-w/double
-   (<|)
-   ([+0.0 _.dconst-0]
-    [+1.0 _.dconst-1])]
   )
 
+(def: (arbitrary-double value)
+  (-> java/lang/Double (Bytecode Any))
+  (do ..monad
+    [index (..lift (//constant/pool.double (//constant.double value)))]
+    (..bytecode $0 $2 @_ _.ldc2-w/double [index])))
+
+(def: double-bits
+  (-> java/lang/Double Int)
+  (|>> java/lang/Double::doubleToRawLongBits
+       (:coerce Int)))
+
+(def: negative-zero-double-bits
+  (..double-bits -0.0))
+
+(def: #export (double value)
+  (-> java/lang/Double (Bytecode Any))
+  (if (i.= ..negative-zero-double-bits
+           (..double-bits value))
+    (..arbitrary-double value)
+    (case value
+      (^template [<special> <instruction>]
+        <special> (..bytecode $0 $2 @_ <instruction> []))
+      ([+0.0 _.dconst-0]
+       [+1.0 _.dconst-1])
+      
+      _ (..arbitrary-double value))))
+
 (exception: #export (invalid-register {id Nat})
   (exception.report
    ["ID" (%.nat id)]))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 2d005d450..d15bec236 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -5,6 +5,7 @@
    [abstract
     ["." monad (#+ Monad do)]]
    [control
+    ["." function]
     ["." try (#+ Try)]
     ["." exception (#+ exception:)]
     [concurrency
@@ -14,12 +15,13 @@
     ["." binary (#+ Binary)]
     ["." bit]
     ["." product]
+    ["." maybe]
     ["." text ("#@." equivalence)
      ["%" format (#+ format)]]
     [collection
      ["." dictionary (#+ Dictionary)]
      ["." row (#+ Row) ("#@." fold)]
-     ["." set]
+     ["." set (#+ Set)]
      ["." list ("#@." monoid functor fold)]]
     [format
      ["_" binary (#+ Writer)]]]
@@ -240,12 +242,94 @@
            #///generation.log]
           row.empty))
 
+  (def: empty
+    (Set Module)
+    (set.new text.hash))
+
+  (type: Mapping
+    (Dictionary Module (Set Module)))
+
+  (type: Dependence
+    {#depends-on Mapping
+     #depended-by Mapping})
+
+  (def: independence
+    Dependence
+    (let [empty (dictionary.new text.hash)]
+      {#depends-on empty
+       #depended-by empty}))
+
+  (def: (depend module import dependence)
+    (-> Module Module Dependence Dependence)
+    (let [transitive-dependency (: (-> (-> Dependence Mapping) Module (Set Module))
+                                   (function (_ lens module)
+                                     (|> dependence
+                                         lens
+                                         (dictionary.get module)
+                                         (maybe.default ..empty))))
+          transitive-depends-on (transitive-dependency (get@ #depends-on) import)
+          transitive-depended-by (transitive-dependency (get@ #depended-by) module)
+          update-dependence (: (-> [Module (Set Module)] [Module (Set Module)]
+                                   (-> Mapping Mapping))
+                               (function (_ [source forward] [target backward])
+                                 (function (_ mapping)
+                                   (let [with-dependence+transitives
+                                         (|> mapping
+                                             (dictionary.upsert source ..empty (set.add target))
+                                             (dictionary.update source (set.union forward)))]
+                                     (list@fold (function (_ previous)
+                                                  (dictionary.upsert previous ..empty (set.add target)))
+                                                with-dependence+transitives
+                                                (set.to-list backward))))))]
+      (|> dependence
+          (update@ #depends-on
+                   (update-dependence
+                    [module transitive-depends-on]
+                    [import transitive-depended-by]))
+          (update@ #depended-by
+                   ((function.flip update-dependence)
+                    [module transitive-depends-on]
+                    [import transitive-depended-by])))))
+
+  (def: (circular-dependency? module import dependence)
+    (-> Module Module Dependence Bit)
+    (let [dependence? (: (-> Module (-> Dependence Mapping) Module Bit)
+                         (function (_ from relationship to)
+                           (let [targets (|> dependence
+                                             relationship
+                                             (dictionary.get from)
+                                             (maybe.default ..empty))]
+                             (set.member? targets to))))]
+      (or (dependence? import (get@ #depends-on) module)
+          (dependence? module (get@ #depended-by) import))))
+
+  (exception: #export (module-cannot-import-itself {module Module})
+    (exception.report
+     ["Module" (%.text module)]))
+
+  (exception: #export (cannot-import-circular-dependency {importer Module}
+                                                         {importee Module})
+    (exception.report
+     ["Importer" (%.text importer)]
+     ["importee" (%.text importee)]))
+
+  (def: (verify-dependencies importer importee dependence)
+    (-> Module Module Dependence (Try Any))
+    (cond (text@= importer importee)
+          (exception.throw ..module-cannot-import-itself [importer])
+
+          (..circular-dependency? importer importee dependence)
+          (exception.throw ..cannot-import-circular-dependency [importer importee])
+
+          ## else
+          (#try.Success [])))
+
   (with-expansions [<Context> (as-is [Archive <State+>])
                     <Result> (as-is (Try <Context>))
                     <Return> (as-is (Promise <Result>))
                     <Signal> (as-is (Resolver <Result>))
                     <Pending> (as-is [<Return> <Signal>])
-                    <Importer> (as-is (-> Module <Return>))
+                    <Importer> (as-is (-> Module Module <Return>))
                     <Compiler> (as-is (-> <Importer> archive.ID <Context> Module <Return>))]
     (def: (parallel initial)
       (All [<type-vars>]
@@ -256,9 +340,11 @@
                             {<Context>
                              initial}
                             {(Var (Dictionary Module <Pending>))
-                             (:assume (stm.var (dictionary.new text.hash)))})]
+                             (:assume (stm.var (dictionary.new text.hash)))})
+            dependence (: (Var Dependence)
+                          (stm.var ..independence))]
         (function (_ compile)
-          (function (import! module)
+          (function (import! importer module)
             (do {@ promise.monad}
               [[return signal] (:share [<type-vars>]
                                        {<Context>
@@ -269,40 +355,52 @@
                                         (:assume
                                          (stm.commit
                                           (do {@ stm.monad}
-                                            [[archive state] (stm.read current)]
-                                            (if (archive.archived? archive module)
-                                              (wrap [(promise@wrap (#try.Success [archive state]))
+                                            [dependence (if (text@= archive.runtime-module importer)
+                                                          (stm.read dependence)
+                                                          (do @
+                                                            [[_ dependence] (stm.update (..depend importer module) dependence)]
+                                                            (wrap dependence)))]
+                                            (case (..verify-dependencies importer module dependence)
+                                              (#try.Failure error)
+                                              (wrap [(promise.resolved (#try.Failure error))
                                                      #.None])
+
+                                              (#try.Success _)
                                               (do @
-                                                [@pending (stm.read pending)]
-                                                (case (dictionary.get module @pending)
-                                                  (#.Some [return signal])
-                                                  (wrap [return
+                                                [[archive state] (stm.read current)]
+                                                (if (archive.archived? archive module)
+                                                  (wrap [(promise@wrap (#try.Success [archive state]))
                                                          #.None])
-                                                  
-                                                  #.None
-                                                  (case (if (archive.reserved? archive module)
-                                                          (do try.monad
-                                                            [module-id (archive.id module archive)]
-                                                            (wrap [module-id archive]))
-                                                          (archive.reserve module archive))
-                                                    (#try.Success [module-id archive])
-                                                    (do @
-                                                      [_ (stm.write [archive state] current)
-                                                       #let [[return signal] (:share [<type-vars>]
-                                                                                     {<Context>
-                                                                                      initial}
-                                                                                     {<Pending>
-                                                                                      (promise.promise [])})]
-                                                       _ (stm.update (dictionary.put module [return signal]) pending)]
+                                                  (do @
+                                                    [@pending (stm.read pending)]
+                                                    (case (dictionary.get module @pending)
+                                                      (#.Some [return signal])
                                                       (wrap [return
-                                                             (#.Some [[archive state]
-                                                                      module-id
-                                                                      signal])]))
-                                                    
-                                                    (#try.Failure error)
-                                                    (wrap [(promise@wrap (#try.Failure error))
-                                                           #.None]))))))))})
+                                                             #.None])
+                                                      
+                                                      #.None
+                                                      (case (if (archive.reserved? archive module)
+                                                              (do try.monad
+                                                                [module-id (archive.id module archive)]
+                                                                (wrap [module-id archive]))
+                                                              (archive.reserve module archive))
+                                                        (#try.Success [module-id archive])
+                                                        (do @
+                                                          [_ (stm.write [archive state] current)
+                                                           #let [[return signal] (:share [<type-vars>]
+                                                                                         {<Context>
+                                                                                          initial}
+                                                                                         {<Pending>
+                                                                                          (promise.promise [])})]
+                                                           _ (stm.update (dictionary.put module [return signal]) pending)]
+                                                          (wrap [return
+                                                                 (#.Some [[archive state]
+                                                                          module-id
+                                                                          signal])]))
+                                                        
+                                                        (#try.Failure error)
+                                                        (wrap [(promise@wrap (#try.Failure error))
+                                                               #.None]))))))))))})
                _ (case signal
                    #.None
                    (wrap [])
@@ -363,16 +461,6 @@
           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>))
@@ -413,9 +501,8 @@
 
                                                    (#.Cons _)
                                                    (do @
-                                                     [_ (:: promise.monad wrap (verify-no-self-import! module new-dependencies))
-                                                      archive,document+ (|> new-dependencies
-                                                                            (list@map import!)
+                                                     [archive,document+ (|> new-dependencies
+                                                                            (list@map (import! module))
                                                                             (monad.seq ..monad))
                                                       #let [archive (|> archive,document+
                                                                         (list@map product.left)
@@ -452,5 +539,5 @@
                                   (do @
                                     [_ (ioW.freeze (get@ #&file-system platform) static archive)]
                                     (promise@wrap (#try.Failure error))))))))))]
-        (compiler compilation-module)))
+        (compiler archive.runtime-module compilation-module)))
     ))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/directive.lux b/stdlib/source/lux/tool/compiler/language/lux/directive.lux
index 8a5e0172a..11dc98bef 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/directive.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/directive.lux
@@ -73,7 +73,7 @@
   )
 
 (def: #export (set-current-module module)
-  (All [anchor expression directive output]
+  (All [anchor expression directive]
     (-> Module (Operation anchor expression directive Any)))
   (do phase.monad
     [_ (..lift-analysis
diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux
index a6865f688..47a9027d0 100644
--- a/stdlib/source/program/aedifex/artifact.lux
+++ b/stdlib/source/program/aedifex/artifact.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux (#- Name)
    [abstract
+    ["." equivalence (#+ Equivalence)]
     ["." hash (#+ Hash)]]
    [data
     ["." text
@@ -25,6 +26,14 @@
    #name Name
    #version Version})
 
+(def: #export equivalence
+  (Equivalence Artifact)
+  ($_ equivalence.product
+      text.equivalence
+      text.equivalence
+      text.equivalence
+      ))
+
 (def: #export hash
   (Hash Artifact)
   ($_ hash.product
diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux
index 92ac3e8ac..18b6719ed 100644
--- a/stdlib/source/program/aedifex/dependency.lux
+++ b/stdlib/source/program/aedifex/dependency.lux
@@ -3,6 +3,7 @@
    ["." host (#+ import:)]
    [abstract
     [monad (#+ do)]
+    ["." equivalence (#+ Equivalence)]
     ["." hash (#+ Hash)]]
    [control
     ["." io (#+ IO)]
@@ -43,6 +44,13 @@
   {#artifact Artifact
    #type ..Type})
 
+(def: #export equivalence
+  (Equivalence Dependency)
+  ($_ equivalence.product
+      //artifact.equivalence
+      text.equivalence
+      ))
+
 (def: #export hash
   (Hash Dependency)
   ($_ hash.product
diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux
new file mode 100644
index 000000000..1107f4d13
--- /dev/null
+++ b/stdlib/source/program/aedifex/format.lux
@@ -0,0 +1,153 @@
+(.module:
+  [lux #*
+   [data
+    ["." text ("#@." equivalence)]
+    [collection
+     ["." dictionary (#+ Dictionary)]
+     ["." list ("#@." functor)]
+     ["." set (#+ Set)]]]
+   [macro
+    ["." code]]]
+  ["." // #_
+   ["/" profile]
+   ["#." project (#+ Project)]
+   ["#." artifact (#+ Artifact)]
+   ["#." dependency (#+ Dependency)]])
+
+(type: #export (Format a)
+  (-> a Code))
+
+(def: (license [name url type])
+  (Format /.License)
+  (`' {#name (~ (code.text name))
+       #url (~ (code.text url))
+       #type (~ (case type
+                  #/.Repo
+                  (' #repo)
+
+                  #/.Manual
+                  (' #manual)))}))
+
+(def: (organization [name url])
+  (Format /.Organization)
+  (`' {#name (~ (code.text name))
+       #url (~ (code.text url))}))
+
+(def: (developer [name url organization])
+  (Format /.Developer)
+  (case organization
+    #.None
+    (`' {#name (~ (code.text name))
+         #url (~ (code.text url))})
+
+    (#.Some value)
+    (`' {#name (~ (code.text name))
+         #url (~ (code.text url))
+         #organization (~ (..organization value))})))
+
+(def: contributor
+  (Format /.Contributor)
+  ..developer)
+
+(type: Aggregate
+  (Dictionary Text Code))
+
+(def: aggregate
+  (Format Aggregate)
+  (|>> dictionary.entries
+       (list@map (function (_ [key value])
+                   [(code.local-tag key) value]))
+       code.record))
+
+(def: empty
+  Aggregate
+  (dictionary.new text.hash))
+
+(def: (on-maybe field value format aggregate)
+  (All [a]
+    (-> Text (Maybe a) (Format a) Aggregate Aggregate))
+  (case value
+    #.None
+    aggregate
+
+    (#.Some value)
+    (dictionary.put field (format value) aggregate)))
+
+(def: (on-list field value format aggregate)
+  (All [a]
+    (-> Text (List a) (Format a) Aggregate Aggregate))
+  (case value
+    #.Nil
+    aggregate
+
+    value
+    (dictionary.put field (` [(~+ (list@map format value))]) aggregate)))
+
+(def: (on-set field value format aggregate)
+  (All [a]
+    (-> Text (Set a) (Format a) Aggregate Aggregate))
+  (..on-list field (set.to-list value) format aggregate))
+
+(def: (on-dictionary field value key-format value-format aggregate)
+  (All [k v]
+    (-> Text (Dictionary k v) (Format k) (Format v) Aggregate Aggregate))
+  (if (dictionary.empty? value)
+    aggregate
+    (dictionary.put field
+                    (|> value
+                        dictionary.entries
+                        (list@map (function (_ [key value])
+                                    [(key-format key) (value-format value)]))
+                        code.record)
+                    aggregate)))
+
+(def: (info value)
+  (Format /.Info)
+  (|> ..empty
+      (..on-maybe "url" (get@ #/.url value) code.text)
+      (..on-maybe "scm" (get@ #/.scm value) code.text)
+      (..on-maybe "description" (get@ #/.description value) code.text)
+      (..on-list "licenses" (get@ #/.licenses value) ..license)
+      (..on-maybe "organization" (get@ #/.organization value) ..organization)
+      (..on-list "developers" (get@ #/.developers value) ..developer)
+      (..on-list "contributors" (get@ #/.contributors value) ..contributor)
+      ..aggregate))
+
+(def: (artifact' [group name version])
+  (-> Artifact (List Code))
+  (list (code.text group)
+        (code.text name)
+        (code.text version)))
+
+(def: (artifact value)
+  (Format Artifact)
+  (` [(~+ (..artifact' value))]))
+
+(def: (dependency [artifact type])
+  (Format Dependency)
+  (if (text@= //dependency.lux-library type)
+    (` [(~+ (..artifact' artifact))])
+    (` [(~+ (..artifact' artifact))
+        (~ (code.text type))])))
+
+(def: #export (profile value)
+  (Format /.Profile)
+  (|> ..empty
+      (..on-list "parents" (get@ #/.parents value) code.text)
+      (..on-maybe "identity" (get@ #/.identity value) ..artifact)
+      (..on-maybe "info" (get@ #/.info value) ..info)
+      (..on-set "repositories" (get@ #/.repositories value) code.text)
+      (..on-set "dependencies" (get@ #/.dependencies value) ..dependency)
+      (..on-set "sources" (get@ #/.sources value) code.text)
+      (..on-maybe "target" (get@ #/.target value) code.text)
+      (..on-maybe "program" (get@ #/.program value) code.text)
+      (..on-maybe "test" (get@ #/.test value) code.text)
+      (..on-dictionary "deploy-repositories" (get@ #/.deploy-repositories value) code.text code.text)
+      ..aggregate))
+
+(def: #export project
+  (Format Project)
+  (|>> dictionary.entries
+       (list@map (function (_ [key value])
+                   [(code.text key) (..profile value)]))
+       code.record))
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index 87f41f2c6..1799db09e 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -81,13 +81,13 @@
                (dictionary.from-list text.hash)
                (<c>.record (<>.some (<>.and <c>.local-tag
                                             <c>.any))))]
-    (<c>.tuple ($_ <>.and
-                   (..singular input "name" ..name)
-                   (..singular input "url" ..url)
-                   (<>.default #/.Repo
-                               (..singular input "type"
-                                           (<>.or (<c>.this! (' #repo))
-                                                  (<c>.this! (' #manual)))))))))
+    ($_ <>.and
+        (..singular input "name" ..name)
+        (..singular input "url" ..url)
+        (<>.default #/.Repo
+                    (..singular input "type"
+                                (<>.or (<c>.this! (' #repo))
+                                       (<c>.this! (' #manual))))))))
 
 (def: organization
   (Parser /.Organization)
@@ -163,9 +163,10 @@
   <c>.text)
 
 (def: deploy-repository
-  (Parser [Text //dependency.Repository])
-  (<c>.tuple (<>.and <c>.text
-                     ..repository)))
+  (Parser (List [Text //dependency.Repository]))
+  (<c>.record (<>.some
+               (<>.and <c>.text
+                       ..repository))))
 
 (def: profile
   (Parser /.Profile)
@@ -207,7 +208,7 @@
            ^deploy-repositories (: (Parser (Dictionary Text //dependency.Repository))
                                    (<| (:: @ map (dictionary.from-list text.hash))
                                        (<>.default (list))
-                                       (..plural input "deploy-repositories" ..deploy-repository)))]]
+                                       (..singular input "deploy-repositories" ..deploy-repository)))]]
     ($_ <>.and
         ^parents
         ^identity
diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux
index 5e5cb6175..02ae69ac8 100644
--- a/stdlib/source/program/aedifex/profile.lux
+++ b/stdlib/source/program/aedifex/profile.lux
@@ -1,7 +1,8 @@
 (.module:
   [lux (#- Info Source Module Name)
    [abstract
-    [monoid (#+ Monoid)]]
+    [monoid (#+ Monoid)]
+    ["." equivalence (#+ Equivalence)]]
    [control
     ["." exception (#+ exception:)]]
    [data
@@ -20,7 +21,7 @@
       [archive
        [descriptor (#+ Module)]]]]]]
   [//
-   [artifact (#+ Artifact)]
+   ["." artifact (#+ Artifact)]
    ["." dependency]])
 
 (def: #export file
@@ -30,11 +31,32 @@
   #Repo
   #Manual)
 
+(structure: distribution-equivalence
+  (Equivalence Distribution)
+
+  (def: (= reference subject)
+    (case [reference subject]
+      (^template [<tag>]
+        [<tag> <tag>]
+        true)
+      ([#Repo]
+       [#Manual])
+
+      _
+      false)))
+
 (type: #export License
   [Text
    URL
    Distribution])
 
+(def: license-equivalence
+  (Equivalence License)
+  ($_ equivalence.product
+      text.equivalence
+      text.equivalence
+      ..distribution-equivalence))
+
 (type: #export SCM
   URL)
 
@@ -42,6 +64,12 @@
   [Text
    URL])
 
+(def: organization-equivalence
+  (Equivalence Organization)
+  ($_ equivalence.product
+      text.equivalence
+      text.equivalence))
+
 (type: #export Email
   Text)
 
@@ -50,6 +78,13 @@
    Email
    (Maybe Organization)])
 
+(def: developer-equivalence
+  (Equivalence Developer)
+  ($_ equivalence.product
+      text.equivalence
+      text.equivalence
+      (maybe.equivalence ..organization-equivalence)))
+
 (type: #export Contributor
   Developer)
 
@@ -62,6 +97,17 @@
    #developers (List Developer)
    #contributors (List Contributor)})
 
+(def: info-equivalence
+  (Equivalence Info)
+  ($_ equivalence.product
+      (maybe.equivalence text.equivalence)
+      (maybe.equivalence text.equivalence)
+      (maybe.equivalence text.equivalence)
+      (list.equivalence ..license-equivalence)
+      (maybe.equivalence ..organization-equivalence)
+      (list.equivalence ..developer-equivalence)
+      (list.equivalence ..developer-equivalence)))
+
 (def: #export default-info
   Info
   {#url #.None
@@ -105,7 +151,42 @@
    #test (Maybe Module)
    #deploy-repositories (Dictionary Text dependency.Repository)})
 
-(exception: #export no-identity)
+(def: #export empty
+  Profile
+  {#parents (list)
+   #identity #.None
+   #info #.None
+   #repositories (set.new text.hash)
+   #dependencies (set.new dependency.hash)
+   #sources (set.new text.hash)
+   #target #.None
+   #program #.None
+   #test #.None
+   #deploy-repositories (dictionary.new text.hash)})
+
+(def: #export equivalence
+  (Equivalence Profile)
+  ($_ equivalence.product
+      ## #parents
+      (list.equivalence text.equivalence)
+      ## #identity
+      (maybe.equivalence artifact.equivalence)
+      ## #info
+      (maybe.equivalence ..info-equivalence)
+      ## #repositories
+      set.equivalence
+      ## #dependencies
+      set.equivalence
+      ## #sources
+      set.equivalence
+      ## #target
+      (maybe.equivalence text.equivalence)
+      ## #program
+      (maybe.equivalence text.equivalence)
+      ## #test
+      (maybe.equivalence text.equivalence)
+      ## #deploy-repositories
+      (dictionary.equivalence text.equivalence)))
 
 (structure: #export monoid
   (Monoid Profile)
@@ -133,3 +214,5 @@
      #program (maybe@compose (get@ #program override) (get@ #program baseline))
      #test (maybe@compose (get@ #test override) (get@ #test baseline))
      #deploy-repositories (dictionary.merge (get@ #deploy-repositories override) (get@ #deploy-repositories baseline))}))
+
+(exception: #export no-identity)
diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux
index 81a8de1af..2e205f722 100644
--- a/stdlib/source/program/aedifex/project.lux
+++ b/stdlib/source/program/aedifex/project.lux
@@ -1,7 +1,8 @@
 (.module:
   [lux (#- Name)
    [abstract
-    ["." monad (#+ do)]]
+    ["." monad (#+ do)]
+    ["." equivalence (#+ Equivalence)]]
    [control
     ["." try (#+ Try)]
     ["." exception (#+ exception:)]]
@@ -18,6 +19,13 @@
 (type: #export Project
   (Dictionary Name Profile))
 
+(def: #export empty
+  (dictionary.from-list text.hash (list [//.default //.empty])))
+
+(def: #export equivalence
+  (Equivalence Project)
+  (dictionary.equivalence //.equivalence))
+
 (exception: #export (unknown-profile {name Name})
   (exception.report
    ["Name" (%.text name)]))
diff --git a/stdlib/source/spec/lux/abstract/comonad.lux b/stdlib/source/spec/lux/abstract/comonad.lux
new file mode 100644
index 000000000..3dfda0bbf
--- /dev/null
+++ b/stdlib/source/spec/lux/abstract/comonad.lux
@@ -0,0 +1,61 @@
+(.module:
+  [lux #*
+   [abstract
+    [monad (#+ do)]]
+   [data
+    [number
+     ["n" nat]]]
+   [math
+    ["." random]]
+   ["_" test (#+ Test)]]
+  {1
+   ["." / (#+ CoMonad)]}
+  [//
+   [functor (#+ Injection Comparison)]])
+
+(def: (left-identity injection (^open "_@."))
+  (All [f] (-> (Injection f) (CoMonad f) Test))
+  (do {@ random.monad}
+    [sample random.nat
+     morphism (:: @ map (function (_ diff)
+                          (|>> _@unwrap (n.+ diff)))
+                  random.nat)
+     #let [start (injection sample)]]
+    (_.test "Left identity."
+            (n.= (morphism start)
+                 (|> start _@split (_@map morphism) _@unwrap)))))
+
+(def: (right-identity injection comparison (^open "_@."))
+  (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test))
+  (do random.monad
+    [sample random.nat
+     #let [start (injection sample)
+           == (comparison n.=)]]
+    (_.test "Right identity."
+            (== start
+                (|> start _@split (_@map _@unwrap))))))
+
+(def: (associativity injection comparison (^open "_@."))
+  (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test))
+  (do {@ random.monad}
+    [sample random.nat
+     increase (:: @ map (function (_ diff)
+                          (|>> _@unwrap (n.+ diff)))
+                  random.nat)
+     decrease (:: @ map (function (_ diff)
+                          (|>> _@unwrap(n.- diff)))
+                  random.nat)
+     #let [start (injection sample)
+           == (comparison n.=)]]
+    (_.test "Associativity."
+            (== (|> start _@split (_@map (|>> _@split (_@map increase) decrease)))
+                (|> start _@split (_@map increase) _@split (_@map decrease))))))
+
+(def: #export (spec injection comparison monad)
+  (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test))
+  (<| (_.with-cover [/.CoMonad])
+      ($_ _.and
+          (..left-identity injection monad)
+          (..right-identity injection comparison monad)
+          (..associativity injection comparison monad)
+          )))
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
new file mode 100644
index 000000000..7286aa50a
--- /dev/null
+++ b/stdlib/source/test/aedifex.lux
@@ -0,0 +1,21 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [control
+    [io (#+ io)]
+    [parser
+     [cli (#+ program:)]]]]
+  ["." / #_
+   ["#." parser]])
+
+(def: test
+  Test
+  ($_ _.and
+      /parser.test
+      ))
+
+(program: args
+  (<| io
+      _.run!
+      (_.times 100)
+      ..test))
diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux
new file mode 100644
index 000000000..497533fbf
--- /dev/null
+++ b/stdlib/source/test/aedifex/parser.lux
@@ -0,0 +1,212 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    [hash (#+ Hash)]]
+   [control
+    [pipe (#+ case>)]
+    ["." try]
+    [parser
+     ["<c>" code]]]
+   [data
+    ["." text
+     ["%" format (#+ format)]]
+    [number
+     ["n" nat]]
+    [collection
+     ["." set (#+ Set)]
+     ["." dictionary (#+ Dictionary)]
+     ["." list ("#@." functor)]]]
+   [math
+    ["." random (#+ Random) ("#@." monad)]]
+   [macro
+    ["." code]]]
+  {#program
+   ["." /
+    ["/#" // #_
+     ["#" profile]
+     ["#." project (#+ Project)]
+     ["#." artifact (#+ Artifact)]
+     ["#." dependency (#+ Repository Dependency)]
+     ["#." format]]]})
+
+(def: distribution
+  (Random //.Distribution)
+  (random.or (random@wrap [])
+             (random@wrap [])))
+
+(def: license
+  (Random //.License)
+  ($_ random.and
+      (random.ascii/alpha 1)
+      (random.ascii/alpha 1)
+      ..distribution))
+
+(def: scm
+  (Random //.SCM)
+  (random.ascii/alpha 1))
+
+(def: organization
+  (Random //.Organization)
+  ($_ random.and
+      (random.ascii/alpha 1)
+      (random.ascii/alpha 1)))
+
+(def: email
+  (Random //.Email)
+  (random.ascii/alpha 1))
+
+(def: developer
+  (Random //.Developer)
+  ($_ random.and
+      (random.ascii/alpha 1)
+      (random.ascii/alpha 1)
+      (random.maybe organization)))
+
+(def: contributor
+  (Random //.Contributor)
+  ..developer)
+
+(def: (list-of random)
+  (All [a] (-> (Random a) (Random (List a))))
+  (do {@ random.monad}
+    [size (:: @ map (n.% 5) random.nat)]
+    (random.list size random)))
+
+(def: (set-of hash random)
+  (All [a] (-> (Hash a) (Random a) (Random (Set a))))
+  (:: random.functor map
+      (set.from-list hash)
+      (..list-of random)))
+
+(def: (dictionary-of key-hash key-random value-random)
+  (All [k v] (-> (Hash k) (Random k) (Random v) (Random (Dictionary k v))))
+  (:: random.functor map
+      (dictionary.from-list key-hash)
+      (..list-of (random.and key-random value-random))))
+
+(def: info
+  (Random //.Info)
+  ($_ random.and
+      (random.maybe (random.ascii/alpha 1))
+      (random.maybe ..scm)
+      (random.maybe (random.ascii/alpha 1))
+      (..list-of ..license)
+      (random.maybe ..organization)
+      (..list-of ..developer)
+      (..list-of ..contributor)
+      ))
+
+(def: name
+  (Random //.Name)
+  (random.ascii/alpha 1))
+
+(def: artifact
+  (Random Artifact)
+  ($_ random.and
+      (random.ascii/alpha 1)
+      (random.ascii/alpha 1)
+      (random.ascii/alpha 1)))
+
+(def: repository
+  (Random Repository)
+  (random.ascii/alpha 1))
+
+(def: dependency
+  (Random Dependency)
+  ($_ random.and
+      ..artifact
+      (random.ascii/alpha 1)))
+
+(def: source
+  (Random //.Source)
+  (random.ascii/alpha 1))
+
+(def: target
+  (Random //.Target)
+  (random.ascii/alpha 1))
+
+(def: profile
+  (Random //.Profile)
+  ($_ random.and
+      (..list-of ..name)
+      (random.maybe ..artifact)
+      (random.maybe ..info)
+      (..set-of text.hash ..repository)
+      (..set-of //dependency.hash ..dependency)
+      (..set-of text.hash ..source)
+      (random.maybe ..target)
+      (random.maybe (random.ascii/alpha 1))
+      (random.maybe (random.ascii/alpha 1))
+      (..dictionary-of text.hash (random.ascii/alpha 1) ..repository)
+      ))
+
+(def: project
+  (Random Project)
+  (..dictionary-of text.hash ..name ..profile))
+
+(def: with-default-sources
+  (-> //.Profile //.Profile)
+  (update@ #//.sources
+           (: (-> (Set //.Source) (Set //.Source))
+              (function (_ sources)
+                (if (set.empty? sources)
+                  (set.from-list text.hash (list //.default-source))
+                  sources)))))
+
+(def: single-profile
+  Test
+  (do random.monad
+    [expected ..profile]
+    (_.test "Single profile."
+            (|> expected
+                //format.profile
+                list
+                (<c>.run /.project)
+                (case> (#try.Success actual)
+                       (|> expected
+                           ..with-default-sources
+                           [//.default]
+                           list
+                           (dictionary.from-list text.hash)
+                           (:: //project.equivalence = actual))
+                       
+                       (#try.Failure error)
+                       false)))))
+
+(def: (with-empty-profile project)
+  (-> Project Project)
+  (if (dictionary.empty? project)
+    //project.empty
+    project))
+
+(def: multiple-profiles
+  Test
+  (do random.monad
+    [expected ..project]
+    (_.test "Multiple profiles."
+            (|> expected
+                //format.project
+                list
+                (<c>.run /.project)
+                (case> (#try.Success actual)
+                       (|> expected
+                           ..with-empty-profile
+                           dictionary.entries
+                           (list@map (function (_ [name profile])
+                                       [name (..with-default-sources profile)]))
+                           (dictionary.from-list text.hash)
+                           (:: //project.equivalence = actual))
+                       
+                       (#try.Failure error)
+                       false)))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.project]
+        ($_ _.and
+            ..single-profile
+            ..multiple-profiles
+            ))))
diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux
index 65d7d1a48..cc2ccf096 100644
--- a/stdlib/source/test/lux/data/identity.lux
+++ b/stdlib/source/test/lux/data/identity.lux
@@ -10,7 +10,8 @@
      [/
       ["$." functor (#+ Injection Comparison)]
       ["$." apply]
-      ["$." monad]]}]
+      ["$." monad]
+      ["$." comonad]]}]
    [data
     ["." text ("#@." monoid equivalence)
      ["%" format (#+ format)]]]]
@@ -28,18 +29,15 @@
 
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /.Identity)))
+  (<| (_.covering /._)
+      (_.with-cover [/.Identity])
       ($_ _.and
-          ($functor.spec ..injection ..comparison /.functor)
-          ($apply.spec ..injection ..comparison /.apply)
-          ($monad.spec ..injection ..comparison /.monad)
-          
-          (let [(^open "/@.") /.comonad]
-            (_.test "CoMonad does not affect values."
-                    (and (text@= "yololol" (/@unwrap "yololol"))
-                         (text@= "yololol" (be /.comonad
-                                             [f text@compose
-                                              a "yolo"
-                                              b "lol"]
-                                             (f a b))))))
+          (_.with-cover [/.functor]
+            ($functor.spec ..injection ..comparison /.functor))
+          (_.with-cover [/.apply]
+            ($apply.spec ..injection ..comparison /.apply))
+          (_.with-cover [/.monad]
+            ($monad.spec ..injection ..comparison /.monad))
+          (_.with-cover [/.comonad]
+            ($comonad.spec ..injection ..comparison /.comonad))
           )))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 4a5672382..f2468ab4f 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -226,8 +226,8 @@
 (def: $Float::random
   (Random java/lang/Float)
   (:: random.monad map
-      (|>> (i.% +1024) i.frac (:coerce java/lang/Double) host.double-to-float)
-      random.int))
+      (|>> (:coerce java/lang/Double) host.double-to-float)
+      random.frac))
 (def: $Float::literal /.float)
 (def: $Float::primitive
   (Primitive java/lang/Float)
@@ -288,27 +288,23 @@
    #random ..$String::random
    #literal ..$String::literal})
 
-(with-expansions [<comparison> (for {@.old
-                                     "jvm leq"
-                                     @.jvm
-                                     "jvm long ="})]
-  (template [<name> <bits> <type> <push> <wrap> <message> <to-long> <unsigned>]
-    [(def: <name>
-       Test
-       (do {@ random.monad}
-         [expected (:: @ map (i64.and (i64.mask <bits>)) random.nat)]
-         (<| (_.lift <message>)
-             (..bytecode (for {@.old
-                               (|>> (:coerce <type>) <to-long> (<comparison> expected))
-                               @.jvm
-                               (|>> (:coerce <type>) <to-long> "jvm object cast" (<comparison> ("jvm object cast" (:coerce java/lang/Long expected))))}))
-             (do /.monad
-               [_ (<push> (|> expected <unsigned> try.assume))]
-               <wrap>))))]
+(template [<name> <bits> <type> <push> <wrap> <message> <to-long> <unsigned>]
+  [(def: <name>
+     Test
+     (do {@ random.monad}
+       [expected (:: @ map (i64.and (i64.mask <bits>)) random.nat)]
+       (<| (_.lift <message>)
+           (..bytecode (for {@.old
+                             (|>> (:coerce <type>) <to-long> ("jvm leq" expected))
+                             @.jvm
+                             (|>> (:coerce <type>) <to-long> "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))}))
+           (do /.monad
+             [_ (<push> (|> expected <unsigned> try.assume))]
+             <wrap>))))]
 
-    [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte-to-long /unsigned.u1]
-    [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short-to-long /unsigned.u2]
-    ))
+  [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte-to-long /unsigned.u1]
+  [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short-to-long /unsigned.u2]
+  )
 
 (template [<name> <type>]
   [(template: (<name> <old-extension> <new-extension>)
@@ -341,19 +337,16 @@
 
 (def: int
   Test
-  (let [int (with-expansions [<comparison> (for {@.old "jvm ieq"
-                                                 @.jvm "jvm int ="})]
-              (: (-> java/lang/Integer (Bytecode Any) (Random Bit))
-                 (function (_ expected bytecode)
-                   (<| (..bytecode (for {@.old
-                                         (|>> (:coerce java/lang/Integer) (<comparison> expected))
-                                         
-                                         @.jvm
-                                         (|>> (:coerce java/lang/Integer) "jvm object cast"
-                                              (<comparison> ("jvm object cast" expected)))}))
-                       (do /.monad
-                         [_ bytecode]
-                         ..$Integer::wrap)))))
+  (let [int (: (-> java/lang/Integer (Bytecode Any) (Random Bit))
+               (function (_ expected bytecode)
+                 (<| (..bytecode (for {@.old
+                                       (|>> (:coerce java/lang/Integer) ("jvm ieq" expected))
+                                       
+                                       @.jvm
+                                       (|>> (:coerce java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" expected)))}))
+                     (do /.monad
+                       [_ bytecode]
+                       ..$Integer::wrap))))
         unary (: (-> (-> java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit))
                  (function (_ reference instruction)
                    (do random.monad
@@ -425,290 +418,296 @@
 
 (def: long
   Test
-  (with-expansions [<comparison> (for {@.old "jvm leq"
-                                       @.jvm "jvm long ="})]
-    (let [long (: (-> java/lang/Long (Bytecode Any) (Random Bit))
+  (let [long (: (-> java/lang/Long (Bytecode Any) (Random Bit))
+                (function (_ expected bytecode)
+                  (<| (..bytecode (for {@.old
+                                        (|>> (:coerce Int) (i.= expected))
+                                        
+                                        @.jvm
+                                        (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))}))
+                      (do /.monad
+                        [_ bytecode]
+                        ..$Long::wrap))))
+        unary (: (-> (-> java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit))
+                 (function (_ reference instruction)
+                   (do random.monad
+                     [subject ..$Long::random]
+                     (long (reference subject)
+                           (do /.monad
+                             [_ (..$Long::literal subject)]
+                             instruction)))))
+        binary (: (-> (-> java/lang/Long java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit))
+                  (function (_ reference instruction)
+                    (do random.monad
+                      [parameter ..$Long::random
+                       subject ..$Long::random]
+                      (long (reference parameter subject)
+                            (do /.monad
+                              [_ (..$Long::literal subject)
+                               _ (..$Long::literal parameter)]
+                              instruction)))))
+        shift (: (-> (-> java/lang/Integer java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit))
+                 (function (_ reference instruction)
+                   (do {@ random.monad}
+                     [parameter (:: @ map (|>> (n.% 64) (:coerce java/lang/Long)) random.nat)
+                      subject ..$Long::random]
+                     (long (reference (host.long-to-int parameter) subject)
+                           (do /.monad
+                             [_ (..$Long::literal subject)
+                              _ (..$Integer::literal (host.long-to-int parameter))]
+                             instruction)))))
+        literal ($_ _.and
+                    (_.lift "LCONST_0" (long (:coerce java/lang/Long +0) /.lconst-0))
+                    (_.lift "LCONST_1" (long (:coerce java/lang/Long +1) /.lconst-1))
+                    (_.lift "LDC2_W/LONG"
+                            (do random.monad
+                              [expected ..$Long::random]
+                              (long expected (..$Long::literal expected)))))
+        arithmetic ($_ _.and
+                       (_.lift "LADD" (binary (long/2 "jvm ladd" "jvm long +") /.ladd))
+                       (_.lift "LSUB" (binary (long/2 "jvm lsub" "jvm long -") /.lsub))
+                       (_.lift "LMUL" (binary (long/2 "jvm lmul" "jvm long *") /.lmul))
+                       (_.lift "LDIV" (binary (long/2 "jvm ldiv" "jvm long /") /.ldiv))
+                       (_.lift "LREM" (binary (long/2 "jvm lrem" "jvm long %") /.lrem))
+                       (_.lift "LNEG" (unary (function (_ value)
+                                               ((long/2 "jvm lsub" "jvm long -")
+                                                value
+                                                (:coerce java/lang/Long +0)))
+                                             /.lneg)))
+        bitwise ($_ _.and
+                    (_.lift "LAND" (binary (long/2 "jvm land" "jvm long and") /.land))
+                    (_.lift "LOR" (binary (long/2 "jvm lor" "jvm long or") /.lor))
+                    (_.lift "LXOR" (binary (long/2 "jvm lxor" "jvm long xor") /.lxor))
+                    (_.lift "LSHL" (shift (int+long/2 "jvm lshl" "jvm long shl") /.lshl))
+                    (_.lift "LSHR" (shift (int+long/2 "jvm lshr" "jvm long shr") /.lshr))
+                    (_.lift "LUSHR" (shift (int+long/2 "jvm lushr" "jvm long ushr") /.lushr)))
+        comparison (_.lift "LCMP"
+                           (do random.monad
+                             [reference ..$Long::random
+                              subject ..$Long::random
+                              #let [expected (cond (i.= (:coerce Int reference) (:coerce Int subject))
+                                                   (:coerce java/lang/Long +0)
+
+                                                   (i.> (:coerce Int reference) (:coerce Int subject))
+                                                   (:coerce java/lang/Long +1)
+
+                                                   ## (i.< (:coerce Int reference) (:coerce Int subject))
+                                                   (:coerce java/lang/Long -1))]]
+                             (<| (..bytecode (for {@.old
+                                                   (|>> (:coerce Int) (i.= expected))
+                                                   
+                                                   @.jvm
+                                                   (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))}))
+                                 (do /.monad
+                                   [_ (..$Long::literal subject)
+                                    _ (..$Long::literal reference)
+                                    _ /.lcmp
+                                    _ /.i2l]
+                                   ..$Long::wrap))))]
+    ($_ _.and
+        (<| (_.context "literal")
+            literal)
+        (<| (_.context "arithmetic")
+            arithmetic)
+        (<| (_.context "bitwise")
+            bitwise)
+        (<| (_.context "comparison")
+            comparison)
+        )))
+
+(def: float
+  Test
+  (let [float (: (-> java/lang/Float (Bytecode Any) (Random Bit))
+                 (function (_ expected bytecode)
+                   (<| (..bytecode (for {@.old
+                                         (function (_ actual)
+                                           (or (|> actual (:coerce java/lang/Float) ("jvm feq" expected))
+                                               (and (f.not-a-number? (:coerce Frac (host.float-to-double expected)))
+                                                    (f.not-a-number? (:coerce Frac (host.float-to-double (:coerce java/lang/Float actual)))))))
+                                         
+                                         @.jvm
+                                         (function (_ actual)
+                                           (or (|> actual (:coerce java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" expected)))
+                                               (and (f.not-a-number? (:coerce Frac (host.float-to-double expected)))
+                                                    (f.not-a-number? (:coerce Frac (host.float-to-double (:coerce java/lang/Float actual)))))))}))
+                       (do /.monad
+                         [_ bytecode]
+                         ..$Float::wrap))))
+        unary (: (-> (-> java/lang/Float java/lang/Float)
+                     (Bytecode Any)
+                     (Random Bit))
+                 (function (_ reference instruction)
+                   (do random.monad
+                     [subject ..$Float::random]
+                     (float (reference subject)
+                            (do /.monad
+                              [_ (..$Float::literal subject)]
+                              instruction)))))
+        binary (: (-> (-> java/lang/Float java/lang/Float java/lang/Float)
+                      (Bytecode Any)
+                      (Random Bit))
+                  (function (_ reference instruction)
+                    (do random.monad
+                      [parameter ..$Float::random
+                       subject ..$Float::random]
+                      (float (reference parameter subject)
+                             (do /.monad
+                               [_ (..$Float::literal subject)
+                                _ (..$Float::literal parameter)]
+                               instruction)))))
+        literal ($_ _.and
+                    (_.lift "FCONST_0" (float (host.double-to-float (:coerce java/lang/Double +0.0)) /.fconst-0))
+                    (_.lift "FCONST_1" (float (host.double-to-float (:coerce java/lang/Double +1.0)) /.fconst-1))
+                    (_.lift "FCONST_2" (float (host.double-to-float (:coerce java/lang/Double +2.0)) /.fconst-2))
+                    (_.lift "LDC_W/FLOAT"
+                            (do random.monad
+                              [expected ..$Float::random]
+                              (float expected (..$Float::literal expected)))))
+        arithmetic ($_ _.and
+                       (_.lift "FADD" (binary (float/2 "jvm fadd" "jvm float +") /.fadd))
+                       (_.lift "FSUB" (binary (float/2 "jvm fsub" "jvm float -") /.fsub))
+                       (_.lift "FMUL" (binary (float/2 "jvm fmul" "jvm float *") /.fmul))
+                       (_.lift "FDIV" (binary (float/2 "jvm fdiv" "jvm float /") /.fdiv))
+                       (_.lift "FREM" (binary (float/2 "jvm frem" "jvm float %") /.frem))
+                       (_.lift "FNEG" (unary (function (_ value)
+                                               ((float/2 "jvm fsub" "jvm float -")
+                                                value
+                                                (host.double-to-float (:coerce java/lang/Double +0.0))))
+                                             /.fneg)))
+        comparison (: (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit))
+                      (function (_ instruction standard)
+                        (do random.monad
+                          [reference ..$Float::random
+                           subject ..$Float::random
+                           #let [expected (if (for {@.old
+                                                    ("jvm feq" reference subject)
+                                                    
+                                                    @.jvm
+                                                    ("jvm float =" ("jvm object cast" reference) ("jvm object cast" subject))})
+                                            +0
+                                            (if (standard reference subject)
+                                              +1
+                                              -1))]]
+                          (<| (..bytecode (|>> (:coerce Int) (i.= expected)))
+                              (do /.monad
+                                [_ (..$Float::literal subject)
+                                 _ (..$Float::literal reference)
+                                 _ instruction
+                                 _ /.i2l]
+                                ..$Long::wrap)))))
+        comparison-standard (: (-> java/lang/Float java/lang/Float Bit)
+                               (function (_ reference subject)
+                                 (for {@.old
+                                       ("jvm fgt" subject reference)
+                                       
+                                       @.jvm
+                                       ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference))})))
+        comparison ($_ _.and
+                       (_.lift "FCMPL" (comparison /.fcmpl comparison-standard))
+                       (_.lift "FCMPG" (comparison /.fcmpg comparison-standard)))]
+    ($_ _.and
+        (<| (_.context "literal")
+            literal)
+        (<| (_.context "arithmetic")
+            arithmetic)
+        (<| (_.context "comparison")
+            comparison)
+        )))
+
+(def: double
+  Test
+  (let [double (: (-> java/lang/Double (Bytecode Any) (Random Bit))
                   (function (_ expected bytecode)
                     (<| (..bytecode (for {@.old
-                                          (|>> (:coerce Int) (i.= expected))
+                                          (function (_ actual)
+                                            (or (|> actual (:coerce java/lang/Double) ("jvm deq" expected))
+                                                (and (f.not-a-number? (:coerce Frac expected))
+                                                     (f.not-a-number? (:coerce Frac actual)))))
                                           
                                           @.jvm
-                                          (|>> (:coerce java/lang/Long) "jvm object cast" (<comparison> ("jvm object cast" expected)))}))
+                                          (function (_ actual)
+                                            (or (|> actual (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))
+                                                (and (f.not-a-number? (:coerce Frac expected))
+                                                     (f.not-a-number? (:coerce Frac actual)))))}))
                         (do /.monad
                           [_ bytecode]
-                          ..$Long::wrap))))
-          unary (: (-> (-> java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit))
-                   (function (_ reference instruction)
-                     (do random.monad
-                       [subject ..$Long::random]
-                       (long (reference subject)
+                          ..$Double::wrap))))
+        unary (: (-> (-> java/lang/Double java/lang/Double) (Bytecode Any) (Random Bit))
+                 (function (_ reference instruction)
+                   (do random.monad
+                     [subject ..$Double::random]
+                     (double (reference subject)
                              (do /.monad
-                               [_ (..$Long::literal subject)]
+                               [_ (..$Double::literal subject)]
                                instruction)))))
-          binary (: (-> (-> java/lang/Long java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit))
-                    (function (_ reference instruction)
-                      (do random.monad
-                        [parameter ..$Long::random
-                         subject ..$Long::random]
-                        (long (reference parameter subject)
+        binary (: (-> (-> java/lang/Double java/lang/Double java/lang/Double) (Bytecode Any) (Random Bit))
+                  (function (_ reference instruction)
+                    (do random.monad
+                      [parameter ..$Double::random
+                       subject ..$Double::random]
+                      (double (reference parameter subject)
                               (do /.monad
-                                [_ (..$Long::literal subject)
-                                 _ (..$Long::literal parameter)]
+                                [_ (..$Double::literal subject)
+                                 _ (..$Double::literal parameter)]
                                 instruction)))))
-          shift (: (-> (-> java/lang/Integer java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit))
-                   (function (_ reference instruction)
-                     (do {@ random.monad}
-                       [parameter (:: @ map (|>> (n.% 64) (:coerce java/lang/Long)) random.nat)
-                        subject ..$Long::random]
-                       (long (reference (host.long-to-int parameter) subject)
-                             (do /.monad
-                               [_ (..$Long::literal subject)
-                                _ (..$Integer::literal (host.long-to-int parameter))]
-                               instruction)))))
-          literal ($_ _.and
-                      (_.lift "LCONST_0" (long (:coerce java/lang/Long +0) /.lconst-0))
-                      (_.lift "LCONST_1" (long (:coerce java/lang/Long +1) /.lconst-1))
-                      (_.lift "LDC2_W/LONG"
-                              (do random.monad
-                                [expected ..$Long::random]
-                                (long expected (..$Long::literal expected)))))
-          arithmetic ($_ _.and
-                         (_.lift "LADD" (binary (long/2 "jvm ladd" "jvm long +") /.ladd))
-                         (_.lift "LSUB" (binary (long/2 "jvm lsub" "jvm long -") /.lsub))
-                         (_.lift "LMUL" (binary (long/2 "jvm lmul" "jvm long *") /.lmul))
-                         (_.lift "LDIV" (binary (long/2 "jvm ldiv" "jvm long /") /.ldiv))
-                         (_.lift "LREM" (binary (long/2 "jvm lrem" "jvm long %") /.lrem))
-                         (_.lift "LNEG" (unary (function (_ value)
-                                                 ((long/2 "jvm lsub" "jvm long -")
-                                                  value
-                                                  (:coerce java/lang/Long +0)))
-                                               /.lneg)))
-          bitwise ($_ _.and
-                      (_.lift "LAND" (binary (long/2 "jvm land" "jvm long and") /.land))
-                      (_.lift "LOR" (binary (long/2 "jvm lor" "jvm long or") /.lor))
-                      (_.lift "LXOR" (binary (long/2 "jvm lxor" "jvm long xor") /.lxor))
-                      (_.lift "LSHL" (shift (int+long/2 "jvm lshl" "jvm long shl") /.lshl))
-                      (_.lift "LSHR" (shift (int+long/2 "jvm lshr" "jvm long shr") /.lshr))
-                      (_.lift "LUSHR" (shift (int+long/2 "jvm lushr" "jvm long ushr") /.lushr)))
-          comparison (_.lift "LCMP"
-                             (do random.monad
-                               [reference ..$Long::random
-                                subject ..$Long::random
-                                #let [expected (cond (i.= (:coerce Int reference) (:coerce Int subject))
-                                                     (:coerce java/lang/Long +0)
-
-                                                     (i.> (:coerce Int reference) (:coerce Int subject))
-                                                     (:coerce java/lang/Long +1)
-
-                                                     ## (i.< (:coerce Int reference) (:coerce Int subject))
-                                                     (:coerce java/lang/Long -1))]]
-                               (<| (..bytecode (for {@.old
-                                                     (|>> (:coerce Int) (i.= expected))
-                                                     
-                                                     @.jvm
-                                                     (|>> (:coerce java/lang/Long) "jvm object cast" (<comparison> ("jvm object cast" expected)))}))
-                                   (do /.monad
-                                     [_ (..$Long::literal subject)
-                                      _ (..$Long::literal reference)
-                                      _ /.lcmp
-                                      _ /.i2l]
-                                     ..$Long::wrap))))]
-      ($_ _.and
-          (<| (_.context "literal")
-              literal)
-          (<| (_.context "arithmetic")
-              arithmetic)
-          (<| (_.context "bitwise")
-              bitwise)
-          (<| (_.context "comparison")
-              comparison)
-          ))))
-
-(def: float
-  Test
-  (with-expansions [<comparison> (for {@.old "jvm feq"
-                                       @.jvm "jvm float ="})]
-    (let [float (: (-> java/lang/Float (Bytecode Any) (Random Bit))
-                   (function (_ expected bytecode)
-                     (<| (..bytecode (for {@.old
-                                           (|>> (:coerce java/lang/Float) ("jvm feq" expected))
-                                           
-                                           @.jvm
-                                           (|>> (:coerce java/lang/Float) "jvm object cast" (<comparison> ("jvm object cast" expected)))}))
-                         (do /.monad
-                           [_ bytecode]
-                           ..$Float::wrap))))
-          unary (: (-> (-> java/lang/Float java/lang/Float)
-                       (Bytecode Any)
-                       (Random Bit))
-                   (function (_ reference instruction)
-                     (do random.monad
-                       [subject ..$Float::random]
-                       (float (reference subject)
+        literal ($_ _.and
+                    (_.lift "DCONST_0" (double (:coerce java/lang/Double +0.0) /.dconst-0))
+                    (_.lift "DCONST_1" (double (:coerce java/lang/Double +1.0) /.dconst-1))
+                    (_.lift "LDC2_W/DOUBLE"
+                            (do random.monad
+                              [expected ..$Double::random]
+                              (double expected (..$Double::literal expected)))))
+        arithmetic ($_ _.and
+                       (_.lift "DADD" (binary (double/2 "jvm dadd" "jvm double +") /.dadd))
+                       (_.lift "DSUB" (binary (double/2 "jvm dsub" "jvm double -") /.dsub))
+                       (_.lift "DMUL" (binary (double/2 "jvm dmul" "jvm double *") /.dmul))
+                       (_.lift "DDIV" (binary (double/2 "jvm ddiv" "jvm double /") /.ddiv))
+                       (_.lift "DREM" (binary (double/2 "jvm drem" "jvm double %") /.drem))
+                       (_.lift "DNEG" (unary (function (_ value)
+                                               ((double/2 "jvm dsub" "jvm double -")
+                                                value
+                                                (:coerce java/lang/Double +0.0)))
+                                             /.dneg)))
+        comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit))
+                      (function (_ instruction standard)
+                        (do random.monad
+                          [reference ..$Double::random
+                           subject ..$Double::random
+                           #let [expected (if (for {@.old
+                                                    ("jvm deq" reference subject)
+                                                    
+                                                    @.jvm
+                                                    ("jvm double =" ("jvm object cast" reference) ("jvm object cast" subject))})
+                                            +0
+                                            (if (standard reference subject)
+                                              +1
+                                              -1))]]
+                          (<| (..bytecode (|>> (:coerce Int) (i.= expected)))
                               (do /.monad
-                                [_ (..$Float::literal subject)]
-                                instruction)))))
-          binary (: (-> (-> java/lang/Float java/lang/Float java/lang/Float)
-                        (Bytecode Any)
-                        (Random Bit))
-                    (function (_ reference instruction)
-                      (do random.monad
-                        [parameter ..$Float::random
-                         subject ..$Float::random]
-                        (float (reference parameter subject)
-                               (do /.monad
-                                 [_ (..$Float::literal subject)
-                                  _ (..$Float::literal parameter)]
-                                 instruction)))))
-          literal ($_ _.and
-                      (_.lift "FCONST_0" (float (host.double-to-float (:coerce java/lang/Double +0.0)) /.fconst-0))
-                      (_.lift "FCONST_1" (float (host.double-to-float (:coerce java/lang/Double +1.0)) /.fconst-1))
-                      (_.lift "FCONST_2" (float (host.double-to-float (:coerce java/lang/Double +2.0)) /.fconst-2))
-                      (_.lift "LDC_W/FLOAT"
-                              (do random.monad
-                                [expected ..$Float::random]
-                                (float expected (..$Float::literal expected)))))
-          arithmetic ($_ _.and
-                         (_.lift "FADD" (binary (float/2 "jvm fadd" "jvm float +") /.fadd))
-                         (_.lift "FSUB" (binary (float/2 "jvm fsub" "jvm float -") /.fsub))
-                         (_.lift "FMUL" (binary (float/2 "jvm fmul" "jvm float *") /.fmul))
-                         (_.lift "FDIV" (binary (float/2 "jvm fdiv" "jvm float /") /.fdiv))
-                         (_.lift "FREM" (binary (float/2 "jvm frem" "jvm float %") /.frem))
-                         (_.lift "FNEG" (unary (function (_ value)
-                                                 ((float/2 "jvm fsub" "jvm float -")
-                                                  value
-                                                  (host.double-to-float (:coerce java/lang/Double +0.0))))
-                                               /.fneg)))
-          comparison (: (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit))
-                        (function (_ instruction standard)
-                          (do random.monad
-                            [reference ..$Float::random
-                             subject ..$Float::random
-                             #let [expected (if (for {@.old
-                                                      ("jvm feq" reference subject)
-                                                      
-                                                      @.jvm
-                                                      (<comparison> ("jvm object cast" reference) ("jvm object cast" subject))})
-                                              +0
-                                              (if (standard reference subject)
-                                                +1
-                                                -1))]]
-                            (<| (..bytecode (|>> (:coerce Int) (i.= expected)))
-                                (do /.monad
-                                  [_ (..$Float::literal subject)
-                                   _ (..$Float::literal reference)
-                                   _ instruction
-                                   _ /.i2l]
-                                  ..$Long::wrap)))))
-          comparison-standard (: (-> java/lang/Float java/lang/Float Bit)
-                                 (function (_ reference subject)
-                                   (for {@.old
-                                         ("jvm fgt" subject reference)
-                                         
-                                         @.jvm
-                                         ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference))})))
-          comparison ($_ _.and
-                         (_.lift "FCMPL" (comparison /.fcmpl comparison-standard))
-                         (_.lift "FCMPG" (comparison /.fcmpg comparison-standard)))]
-      ($_ _.and
-          (<| (_.context "literal")
-              literal)
-          (<| (_.context "arithmetic")
-              arithmetic)
-          (<| (_.context "comparison")
-              comparison)
-          ))))
-
-(def: double
-  Test
-  (with-expansions [<comparison> (for {@.old "jvm deq"
-                                       @.jvm "jvm double ="})]
-    (let [double (: (-> java/lang/Double (Bytecode Any) (Random Bit))
-                    (function (_ expected bytecode)
-                      (<| (..bytecode (for {@.old
-                                            (|>> (:coerce java/lang/Double) ("jvm deq" expected))
-                                            
-                                            @.jvm
-                                            (|>> (:coerce java/lang/Double) "jvm object cast" (<comparison> ("jvm object cast" expected)))}))
-                          (do /.monad
-                            [_ bytecode]
-                            ..$Double::wrap))))
-          unary (: (-> (-> java/lang/Double java/lang/Double) (Bytecode Any) (Random Bit))
-                   (function (_ reference instruction)
-                     (do random.monad
-                       [subject ..$Double::random]
-                       (double (reference subject)
-                               (do /.monad
-                                 [_ (..$Double::literal subject)]
-                                 instruction)))))
-          binary (: (-> (-> java/lang/Double java/lang/Double java/lang/Double) (Bytecode Any) (Random Bit))
-                    (function (_ reference instruction)
-                      (do random.monad
-                        [parameter ..$Double::random
-                         subject ..$Double::random]
-                        (double (reference parameter subject)
-                                (do /.monad
-                                  [_ (..$Double::literal subject)
-                                   _ (..$Double::literal parameter)]
-                                  instruction)))))
-          literal ($_ _.and
-                      (_.lift "DCONST_0" (double (:coerce java/lang/Double +0.0) /.dconst-0))
-                      (_.lift "DCONST_1" (double (:coerce java/lang/Double +1.0) /.dconst-1))
-                      (_.lift "LDC2_W/DOUBLE"
-                              (do random.monad
-                                [expected ..$Double::random]
-                                (double expected (..$Double::literal expected)))))
-          arithmetic ($_ _.and
-                         (_.lift "DADD" (binary (double/2 "jvm dadd" "jvm double +") /.dadd))
-                         (_.lift "DSUB" (binary (double/2 "jvm dsub" "jvm double -") /.dsub))
-                         (_.lift "DMUL" (binary (double/2 "jvm dmul" "jvm double *") /.dmul))
-                         (_.lift "DDIV" (binary (double/2 "jvm ddiv" "jvm double /") /.ddiv))
-                         (_.lift "DREM" (binary (double/2 "jvm drem" "jvm double %") /.drem))
-                         (_.lift "DNEG" (unary (function (_ value)
-                                                 ((double/2 "jvm dsub" "jvm double -")
-                                                  value
-                                                  (:coerce java/lang/Double +0.0)))
-                                               /.dneg)))
-          comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit))
-                        (function (_ instruction standard)
-                          (do random.monad
-                            [reference ..$Double::random
-                             subject ..$Double::random
-                             #let [expected (if (for {@.old
-                                                      ("jvm deq" reference subject)
-                                                      
-                                                      @.jvm
-                                                      (<comparison> ("jvm object cast" reference) ("jvm object cast" subject))})
-                                              +0
-                                              (if (standard reference subject)
-                                                +1
-                                                -1))]]
-                            (<| (..bytecode (|>> (:coerce Int) (i.= expected)))
-                                (do /.monad
-                                  [_ (..$Double::literal subject)
-                                   _ (..$Double::literal reference)
-                                   _ instruction
-                                   _ /.i2l]
-                                  ..$Long::wrap)))))
-          ## https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-6.html#jvms-6.5.dcmp_op
-          comparison-standard (: (-> java/lang/Double java/lang/Double Bit)
-                                 (function (_ reference subject)
-                                   (for {@.old
-                                         ("jvm dgt" subject reference)
-                                         
-                                         @.jvm
-                                         ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))})))
-          comparison ($_ _.and
-                         (_.lift "DCMPL" (comparison /.dcmpl comparison-standard))
-                         (_.lift "DCMPG" (comparison /.dcmpg comparison-standard)))]
-      ($_ _.and
-          (<| (_.context "literal")
-              literal)
-          (<| (_.context "arithmetic")
-              arithmetic)
-          (<| (_.context "comparison")
-              comparison)
-          ))))
+                                [_ (..$Double::literal subject)
+                                 _ (..$Double::literal reference)
+                                 _ instruction
+                                 _ /.i2l]
+                                ..$Long::wrap)))))
+        ## https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-6.html#jvms-6.5.dcmp_op
+        comparison-standard (: (-> java/lang/Double java/lang/Double Bit)
+                               (function (_ reference subject)
+                                 (for {@.old
+                                       ("jvm dgt" subject reference)
+                                       
+                                       @.jvm
+                                       ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))})))
+        comparison ($_ _.and
+                       (_.lift "DCMPL" (comparison /.dcmpl comparison-standard))
+                       (_.lift "DCMPG" (comparison /.dcmpg comparison-standard)))]
+    ($_ _.and
+        (<| (_.context "literal")
+            literal)
+        (<| (_.context "arithmetic")
+            arithmetic)
+        (<| (_.context "comparison")
+            comparison)
+        )))
 
 (def: primitive
   Test
@@ -773,7 +772,8 @@
   ($_ _.and
       (<| (_.lift "INVOKESTATIC")
           (do random.monad
-            [expected ..$Double::random])
+            [expected (random.filter (|>> (:coerce Frac) f.not-a-number? not)
+                                     ..$Double::random)])
           (..bytecode (for {@.old
                             (|>> (:coerce java/lang/Double) ("jvm deq" expected))
                             
@@ -793,7 +793,8 @@
             ..$Boolean::wrap))
       (<| (_.lift "INVOKESPECIAL")
           (do random.monad
-            [expected ..$Double::random])
+            [expected (random.filter (|>> (:coerce Frac) f.not-a-number? not)
+                                     ..$Double::random)])
           (..bytecode (for {@.old
                             (|>> (:coerce java/lang/Double) ("jvm deq" expected))