Calculate SHA-1 and MD5 hashes.

1 files changed, 167 insertions, 44 deletions

diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index cc2d8012d..0fc1c24be 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -1,54 +1,177 @@
 (.module:
   [lux #*
-   ["%" data/text/format (#+ format)]
-   [abstract/monad (#+ do)]
-   ["r" math/random (#+ Random)]
    ["_" test (#+ Test)]
+   [math
+    ["." random (#+ Random) ("#@." monad)]]
+   [abstract
+    [monad (#+ do)]
+    {[0 #spec]
+     [/
+      ["$." equivalence]]}]
+   [control
+    ["." try (#+ Try)]]
    [data
-    ["." text ("#@." equivalence)]
+    ["." product]
+    ["." text]
     [number
-     ["i" int]
-     ["f" frac]]]]
+     ["n" nat]]
+    [collection
+     ["." list ("#@." functor)]]]
+   [tool
+    [compiler
+     [language
+      [lux
+       ["." syntax]]]]]]
   {1
    ["." /]})
 
+(def: random-text
+  (Random Text)
+  (random.ascii/alpha 10))
+
+(def: random-name
+  (Random Name)
+  (random.and ..random-text ..random-text))
+
+(def: (random-sequence random)
+  (All [a] (-> (Random a) (Random (List a))))
+  (do {@ random.monad}
+    [size (|> random.nat (:: @ map (n.% 3)))]
+    (random.list size random)))
+
+(def: (random-record random)
+  (All [a] (-> (Random a) (Random (List [a a]))))
+  (do {@ random.monad}
+    [size (|> random.nat (:: @ map (n.% 3)))]
+    (random.list size (random.and random random))))
+
+(def: random
+  (Random Code)
+  (random.rec
+   (function (_ random)
+     ($_ random.either
+         (random@map /.bit random.bit)
+         (random@map /.nat random.nat)
+         (random@map /.int random.int)
+         (random@map /.rev random.rev)
+         (random@map /.frac random.safe-frac)
+         (random@map /.text ..random-text)
+         (random@map /.identifier ..random-name)
+         (random@map /.tag ..random-name)
+         (random@map /.form (..random-sequence random))
+         (random@map /.tuple (..random-sequence random))
+         (random@map /.record (..random-record random))
+         ))))
+
+(def: (read source-code)
+  (-> Text (Try Code))
+  (let [parse (syntax.parse ""
+                            syntax.no-aliases
+                            (text.size source-code))
+        start (: Source
+                 [.dummy-cursor 0 source-code])]
+    (case (parse start)
+      (#.Left [end error])
+      (#try.Failure error)
+      
+      (#.Right [end lux-code])
+      (#try.Success lux-code))))
+
+(def: (replace-simulation [original substitute])
+  (-> [Code Code] (Random [Code Code]))
+  (random.rec
+   (function (_ replace-simulation)
+     (let [for-sequence (: (-> (-> (List Code) Code) (Random [Code Code]))
+                           (function (_ to-code)
+                             (do {@ random.monad}
+                               [parts (..random-sequence replace-simulation)]
+                               (wrap [(to-code (list@map product.left parts))
+                                      (to-code (list@map product.right parts))]))))]
+       ($_ random.either
+           (random@wrap [original substitute])
+           (do {@ random.monad}
+             [sample (random.filter (|>> (:: /.equivalence = original) not)
+                                    ($_ random.either
+                                        (random@map /.bit random.bit)
+                                        (random@map /.nat random.nat)
+                                        (random@map /.int random.int)
+                                        (random@map /.rev random.rev)
+                                        (random@map /.frac random.safe-frac)
+                                        (random@map /.text ..random-text)
+                                        (random@map /.identifier ..random-name)
+                                        (random@map /.tag ..random-name)))]
+             (wrap [sample sample]))
+           (for-sequence /.form)
+           (for-sequence /.tuple)
+           (do {@ random.monad}
+             [parts (..random-sequence replace-simulation)]
+             (wrap [(/.record (let [parts' (list@map product.left parts)]
+                                (list.zip2 parts' parts')))
+                    (/.record (let [parts' (list@map product.right parts)]
+                                (list.zip2 parts' parts')))]))
+           )))))
+
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /._)))
-      (do {@ r.monad}
-        [bit r.bit
-         nat r.nat
-         int r.int
-         rev r.rev
-         above (:: @ map (i.% +100) r.int)
-         below (:: @ map (i.% +100) r.int)
-         #let [frac (|> below
-                        (i./ +100)
-                        i.frac
-                        (f.+ (i.frac above))
-                        (f.* -1.0))]
-         text (r.ascii 10)
-         short (r.ascii/alpha 10)
-         module (r.ascii/alpha 10)
-         #let [name [module short]]]
-        (`` ($_ _.and
-                (~~ (template [<desc> <code> <text>]
-                      [(let [code <code>]
-                         (_.test (format "Can produce " <desc> " code node.")
-                                 (and (text@= <text> (/.to-text code))
-                                      (:: /.equivalence = code code))))]
-
-                      ["bit"              (/.bit bit)                                 (%.bit bit)]
-                      ["nat"              (/.nat nat)                                 (%.nat nat)]
-                      ["int"              (/.int int)                                 (%.int int)]
-                      ["rev"              (/.rev rev)                                 (%.rev rev)]
-                      ["frac"             (/.frac frac)                               (%.frac frac)]
-                      ["text"             (/.text text)                               (%.text text)]
-                      ["local-ltag"       (/.local-tag short)                         (format "#" short)]
-                      ["lag"              (/.tag [module short])                      (format "#" (%.name name))]
-                      ["local-identifier" (/.local-identifier short)                  short]
-                      ["identifier"       (/.identifier [module short])               (%.name name)]
-                      ["form"             (/.form (list (/.bit bit) (/.int int)))     (format "(" (%.bit bit) " " (%.int int) ")")]
-                      ["tuple"            (/.tuple (list (/.bit bit) (/.int int)))    (format "[" (%.bit bit) " " (%.int int) "]")]
-                      ["record"           (/.record (list [(/.bit bit) (/.int int)])) (format "{" (%.bit bit) " " (%.int int) "}")]
-                      )))))))
+  (<| (_.covering /._)
+      ($_ _.and
+          (_.with-cover [/.equivalence]
+            ($equivalence.spec /.equivalence ..random))
+          (_.with-cover [/.to-text]
+            (`` ($_ _.and
+                    (~~ (template [<coverage> <random> <tag>]
+                          [(do {@ random.monad}
+                             [value <random>]
+                             (_.cover [<coverage>]
+                                      (and (case (..read (/.to-text (<coverage> value)))
+                                             (#try.Success lux-code)
+                                             (:: /.equivalence =
+                                                 lux-code
+                                                 (<coverage> value))
+                                             
+                                             (#try.Failure error)
+                                             false)
+                                           (:: /.equivalence =
+                                               [.dummy-cursor (<tag> value)]
+                                               (<coverage> value)))))]
+
+                          [/.bit random.bit #.Bit]
+                          [/.nat random.nat #.Nat]
+                          [/.int random.int #.Int]
+                          [/.rev random.rev #.Rev]
+                          [/.frac random.safe-frac #.Frac]
+                          [/.text ..random-text #.Text]
+                          [/.tag ..random-name #.Tag]
+                          [/.identifier ..random-name #.Identifier]
+                          [/.form (..random-sequence ..random) #.Form]
+                          [/.tuple (..random-sequence ..random) #.Tuple]
+                          [/.record (..random-record ..random) #.Record]
+                          ))
+                    (~~ (template [<coverage> <random> <tag>]
+                          [(do {@ random.monad}
+                             [value <random>]
+                             (_.cover [<coverage>]
+                                      (and (case (..read (/.to-text (<coverage> value)))
+                                             (#try.Success lux-code)
+                                             (:: /.equivalence =
+                                                 lux-code
+                                                 (<coverage> value))
+                                             
+                                             (#try.Failure error)
+                                             false)
+                                           (:: /.equivalence =
+                                               [.dummy-cursor (<tag> ["" value])]
+                                               (<coverage> value)))
+                                      ))]
+
+                          [/.local-tag        ..random-text #.Tag]
+                          [/.local-identifier ..random-text #.Identifier]
+                          )))))
+          (do {@ random.monad}
+            [[original substitute] (random.and ..random ..random)
+             [sample expected] (..replace-simulation [original substitute])]
+            (_.cover [/.replace]
+                     (:: /.equivalence =
+                         expected
+                         (/.replace original substitute sample))))
+          )))