- Updated new compiler to latest version of stdlib.

1 files changed, 349 insertions, 325 deletions

diff --git a/new-luxc/test/test/luxc/analyser/procedure/common.lux b/new-luxc/test/test/luxc/analyser/procedure/common.lux
index ee342971b..208076d6e 100644
--- a/new-luxc/test/test/luxc/analyser/procedure/common.lux
+++ b/new-luxc/test/test/luxc/analyser/procedure/common.lux
@@ -40,358 +40,382 @@
   )
 
 (context: "Lux procedures"
-  [[primT primC] gen-primitive
-   [antiT antiC] (|> gen-primitive
-                     (r;filter (|>. product;left (type/= primT) not)))]
-  ($_ seq
-      (test "Can test for reference equality."
-            (check-success+ "lux is" (list primC primC) Bool))
-      (test "Reference equality must be done with elements of the same type."
-            (check-failure+ "lux is" (list primC antiC) Bool))
-      (test "Can 'try' risky IO computations."
-            (check-success+ "lux try"
-                            (list (` ((~' _lux_function) (~' _) (~' _) (~ primC))))
-                            (type (Either Text primT))))
-      ))
+  (<| (times +100)
+      (do @
+        [[primT primC] gen-primitive
+         [antiT antiC] (|> gen-primitive
+                           (r;filter (|>. product;left (type/= primT) not)))]
+        ($_ seq
+            (test "Can test for reference equality."
+                  (check-success+ "lux is" (list primC primC) Bool))
+            (test "Reference equality must be done with elements of the same type."
+                  (check-failure+ "lux is" (list primC antiC) Bool))
+            (test "Can 'try' risky IO computations."
+                  (check-success+ "lux try"
+                                  (list (` ((~' _lux_function) (~' _) (~' _) (~ primC))))
+                                  (type (Either Text primT))))
+            ))))
 
 (context: "Bit procedures"
-  [subjectC (|> r;nat (:: @ map code;nat))
-   signedC (|> r;int (:: @ map code;int))
-   paramC (|> r;nat (:: @ map code;nat))]
-  ($_ seq
-      (test "Can count the number of 1 bits in a bit pattern."
-            (check-success+ "lux bit count" (list subjectC) Nat))
-      (test "Can perform bit 'and'."
-            (check-success+ "lux bit and" (list subjectC paramC) Nat))
-      (test "Can perform bit 'or'."
-            (check-success+ "lux bit or" (list subjectC paramC) Nat))
-      (test "Can perform bit 'xor'."
-            (check-success+ "lux bit xor" (list subjectC paramC) Nat))
-      (test "Can shift bit pattern to the left."
-            (check-success+ "lux bit shift-left" (list subjectC paramC) Nat))
-      (test "Can shift bit pattern to the right."
-            (check-success+ "lux bit unsigned-shift-right" (list subjectC paramC) Nat))
-      (test "Can shift signed bit pattern to the right."
-            (check-success+ "lux bit shift-right" (list signedC paramC) Int))
-      ))
+  (<| (times +100)
+      (do @
+        [subjectC (|> r;nat (:: @ map code;nat))
+         signedC (|> r;int (:: @ map code;int))
+         paramC (|> r;nat (:: @ map code;nat))]
+        ($_ seq
+            (test "Can count the number of 1 bits in a bit pattern."
+                  (check-success+ "lux bit count" (list subjectC) Nat))
+            (test "Can perform bit 'and'."
+                  (check-success+ "lux bit and" (list subjectC paramC) Nat))
+            (test "Can perform bit 'or'."
+                  (check-success+ "lux bit or" (list subjectC paramC) Nat))
+            (test "Can perform bit 'xor'."
+                  (check-success+ "lux bit xor" (list subjectC paramC) Nat))
+            (test "Can shift bit pattern to the left."
+                  (check-success+ "lux bit shift-left" (list subjectC paramC) Nat))
+            (test "Can shift bit pattern to the right."
+                  (check-success+ "lux bit unsigned-shift-right" (list subjectC paramC) Nat))
+            (test "Can shift signed bit pattern to the right."
+                  (check-success+ "lux bit shift-right" (list signedC paramC) Int))
+            ))))
 
 (context: "Nat procedures"
-  [subjectC (|> r;nat (:: @ map code;nat))
-   paramC (|> r;nat (:: @ map code;nat))]
-  ($_ seq
-      (test "Can add natural numbers."
-            (check-success+ "lux nat +" (list subjectC paramC) Nat))
-      (test "Can subtract natural numbers."
-            (check-success+ "lux nat -" (list subjectC paramC) Nat))
-      (test "Can multiply natural numbers."
-            (check-success+ "lux nat *" (list subjectC paramC) Nat))
-      (test "Can divide natural numbers."
-            (check-success+ "lux nat /" (list subjectC paramC) Nat))
-      (test "Can calculate remainder of natural numbers."
-            (check-success+ "lux nat %" (list subjectC paramC) Nat))
-      (test "Can test equality of natural numbers."
-            (check-success+ "lux nat =" (list subjectC paramC) Bool))
-      (test "Can compare natural numbers."
-            (check-success+ "lux nat <" (list subjectC paramC) Bool))
-      (test "Can obtain minimum natural number."
-            (check-success+ "lux nat min" (list) Nat))
-      (test "Can obtain maximum natural number."
-            (check-success+ "lux nat max" (list) Nat))
-      (test "Can convert natural number to integer."
-            (check-success+ "lux nat to-int" (list subjectC) Int))
-      (test "Can convert natural number to text."
-            (check-success+ "lux nat to-text" (list subjectC) Text))
-      ))
+  (<| (times +100)
+      (do @
+        [subjectC (|> r;nat (:: @ map code;nat))
+         paramC (|> r;nat (:: @ map code;nat))]
+        ($_ seq
+            (test "Can add natural numbers."
+                  (check-success+ "lux nat +" (list subjectC paramC) Nat))
+            (test "Can subtract natural numbers."
+                  (check-success+ "lux nat -" (list subjectC paramC) Nat))
+            (test "Can multiply natural numbers."
+                  (check-success+ "lux nat *" (list subjectC paramC) Nat))
+            (test "Can divide natural numbers."
+                  (check-success+ "lux nat /" (list subjectC paramC) Nat))
+            (test "Can calculate remainder of natural numbers."
+                  (check-success+ "lux nat %" (list subjectC paramC) Nat))
+            (test "Can test equality of natural numbers."
+                  (check-success+ "lux nat =" (list subjectC paramC) Bool))
+            (test "Can compare natural numbers."
+                  (check-success+ "lux nat <" (list subjectC paramC) Bool))
+            (test "Can obtain minimum natural number."
+                  (check-success+ "lux nat min" (list) Nat))
+            (test "Can obtain maximum natural number."
+                  (check-success+ "lux nat max" (list) Nat))
+            (test "Can convert natural number to integer."
+                  (check-success+ "lux nat to-int" (list subjectC) Int))
+            (test "Can convert natural number to text."
+                  (check-success+ "lux nat to-text" (list subjectC) Text))
+            ))))
 
 (context: "Int procedures"
-  [subjectC (|> r;int (:: @ map code;int))
-   paramC (|> r;int (:: @ map code;int))]
-  ($_ seq
-      (test "Can add integers."
-            (check-success+ "lux int +" (list subjectC paramC) Int))
-      (test "Can subtract integers."
-            (check-success+ "lux int -" (list subjectC paramC) Int))
-      (test "Can multiply integers."
-            (check-success+ "lux int *" (list subjectC paramC) Int))
-      (test "Can divide integers."
-            (check-success+ "lux int /" (list subjectC paramC) Int))
-      (test "Can calculate remainder of integers."
-            (check-success+ "lux int %" (list subjectC paramC) Int))
-      (test "Can test equality of integers."
-            (check-success+ "lux int =" (list subjectC paramC) Bool))
-      (test "Can compare integers."
-            (check-success+ "lux int <" (list subjectC paramC) Bool))
-      (test "Can obtain minimum integer."
-            (check-success+ "lux int min" (list) Int))
-      (test "Can obtain maximum integer."
-            (check-success+ "lux int max" (list) Int))
-      (test "Can convert integer to natural number."
-            (check-success+ "lux int to-nat" (list subjectC) Nat))
-      (test "Can convert integer to frac number."
-            (check-success+ "lux int to-frac" (list subjectC) Frac))
-      ))
+  (<| (times +100)
+      (do @
+        [subjectC (|> r;int (:: @ map code;int))
+         paramC (|> r;int (:: @ map code;int))]
+        ($_ seq
+            (test "Can add integers."
+                  (check-success+ "lux int +" (list subjectC paramC) Int))
+            (test "Can subtract integers."
+                  (check-success+ "lux int -" (list subjectC paramC) Int))
+            (test "Can multiply integers."
+                  (check-success+ "lux int *" (list subjectC paramC) Int))
+            (test "Can divide integers."
+                  (check-success+ "lux int /" (list subjectC paramC) Int))
+            (test "Can calculate remainder of integers."
+                  (check-success+ "lux int %" (list subjectC paramC) Int))
+            (test "Can test equality of integers."
+                  (check-success+ "lux int =" (list subjectC paramC) Bool))
+            (test "Can compare integers."
+                  (check-success+ "lux int <" (list subjectC paramC) Bool))
+            (test "Can obtain minimum integer."
+                  (check-success+ "lux int min" (list) Int))
+            (test "Can obtain maximum integer."
+                  (check-success+ "lux int max" (list) Int))
+            (test "Can convert integer to natural number."
+                  (check-success+ "lux int to-nat" (list subjectC) Nat))
+            (test "Can convert integer to frac number."
+                  (check-success+ "lux int to-frac" (list subjectC) Frac))
+            ))))
 
 (context: "Deg procedures"
-  [subjectC (|> r;deg (:: @ map code;deg))
-   paramC (|> r;deg (:: @ map code;deg))
-   natC (|> r;nat (:: @ map code;nat))]
-  ($_ seq
-      (test "Can add degrees."
-            (check-success+ "lux deg +" (list subjectC paramC) Deg))
-      (test "Can subtract degrees."
-            (check-success+ "lux deg -" (list subjectC paramC) Deg))
-      (test "Can multiply degrees."
-            (check-success+ "lux deg *" (list subjectC paramC) Deg))
-      (test "Can divide degrees."
-            (check-success+ "lux deg /" (list subjectC paramC) Deg))
-      (test "Can calculate remainder of degrees."
-            (check-success+ "lux deg %" (list subjectC paramC) Deg))
-      (test "Can test equality of degrees."
-            (check-success+ "lux deg =" (list subjectC paramC) Bool))
-      (test "Can compare degrees."
-            (check-success+ "lux deg <" (list subjectC paramC) Bool))
-      (test "Can obtain minimum degree."
-            (check-success+ "lux deg min" (list) Deg))
-      (test "Can obtain maximum degree."
-            (check-success+ "lux deg max" (list) Deg))
-      (test "Can convert degree to frac number."
-            (check-success+ "lux deg to-frac" (list subjectC) Frac))
-      (test "Can scale degree."
-            (check-success+ "lux deg scale" (list subjectC natC) Deg))
-      (test "Can calculate the reciprocal of a natural number."
-            (check-success+ "lux deg reciprocal" (list natC) Deg))
-      ))
+  (<| (times +100)
+      (do @
+        [subjectC (|> r;deg (:: @ map code;deg))
+         paramC (|> r;deg (:: @ map code;deg))
+         natC (|> r;nat (:: @ map code;nat))]
+        ($_ seq
+            (test "Can add degrees."
+                  (check-success+ "lux deg +" (list subjectC paramC) Deg))
+            (test "Can subtract degrees."
+                  (check-success+ "lux deg -" (list subjectC paramC) Deg))
+            (test "Can multiply degrees."
+                  (check-success+ "lux deg *" (list subjectC paramC) Deg))
+            (test "Can divide degrees."
+                  (check-success+ "lux deg /" (list subjectC paramC) Deg))
+            (test "Can calculate remainder of degrees."
+                  (check-success+ "lux deg %" (list subjectC paramC) Deg))
+            (test "Can test equality of degrees."
+                  (check-success+ "lux deg =" (list subjectC paramC) Bool))
+            (test "Can compare degrees."
+                  (check-success+ "lux deg <" (list subjectC paramC) Bool))
+            (test "Can obtain minimum degree."
+                  (check-success+ "lux deg min" (list) Deg))
+            (test "Can obtain maximum degree."
+                  (check-success+ "lux deg max" (list) Deg))
+            (test "Can convert degree to frac number."
+                  (check-success+ "lux deg to-frac" (list subjectC) Frac))
+            (test "Can scale degree."
+                  (check-success+ "lux deg scale" (list subjectC natC) Deg))
+            (test "Can calculate the reciprocal of a natural number."
+                  (check-success+ "lux deg reciprocal" (list natC) Deg))
+            ))))
 
 (context: "Frac procedures"
-  [subjectC (|> r;frac (:: @ map code;frac))
-   paramC (|> r;frac (:: @ map code;frac))
-   encodedC (|> (r;text +5) (:: @ map code;text))]
-  ($_ seq
-      (test "Can add frac numbers."
-            (check-success+ "lux frac +" (list subjectC paramC) Frac))
-      (test "Can subtract frac numbers."
-            (check-success+ "lux frac -" (list subjectC paramC) Frac))
-      (test "Can multiply frac numbers."
-            (check-success+ "lux frac *" (list subjectC paramC) Frac))
-      (test "Can divide frac numbers."
-            (check-success+ "lux frac /" (list subjectC paramC) Frac))
-      (test "Can calculate remainder of frac numbers."
-            (check-success+ "lux frac %" (list subjectC paramC) Frac))
-      (test "Can test equality of frac numbers."
-            (check-success+ "lux frac =" (list subjectC paramC) Bool))
-      (test "Can compare frac numbers."
-            (check-success+ "lux frac <" (list subjectC paramC) Bool))
-      (test "Can obtain minimum frac number."
-            (check-success+ "lux frac min" (list) Frac))
-      (test "Can obtain maximum frac number."
-            (check-success+ "lux frac max" (list) Frac))
-      (test "Can obtain smallest frac number."
-            (check-success+ "lux frac smallest" (list) Frac))
-      (test "Can obtain not-a-number."
-            (check-success+ "lux frac not-a-number" (list) Frac))
-      (test "Can obtain positive infinity."
-            (check-success+ "lux frac positive-infinity" (list) Frac))
-      (test "Can obtain negative infinity."
-            (check-success+ "lux frac negative-infinity" (list) Frac))
-      (test "Can convert frac number to integer."
-            (check-success+ "lux frac to-int" (list subjectC) Int))
-      (test "Can convert frac number to degree."
-            (check-success+ "lux frac to-deg" (list subjectC) Deg))
-      (test "Can convert frac number to text."
-            (check-success+ "lux frac encode" (list subjectC) Text))
-      (test "Can convert text to frac number."
-            (check-success+ "lux frac encode" (list encodedC) (type (Maybe Frac))))
-      ))
+  (<| (times +100)
+      (do @
+        [subjectC (|> r;frac (:: @ map code;frac))
+         paramC (|> r;frac (:: @ map code;frac))
+         encodedC (|> (r;text +5) (:: @ map code;text))]
+        ($_ seq
+            (test "Can add frac numbers."
+                  (check-success+ "lux frac +" (list subjectC paramC) Frac))
+            (test "Can subtract frac numbers."
+                  (check-success+ "lux frac -" (list subjectC paramC) Frac))
+            (test "Can multiply frac numbers."
+                  (check-success+ "lux frac *" (list subjectC paramC) Frac))
+            (test "Can divide frac numbers."
+                  (check-success+ "lux frac /" (list subjectC paramC) Frac))
+            (test "Can calculate remainder of frac numbers."
+                  (check-success+ "lux frac %" (list subjectC paramC) Frac))
+            (test "Can test equality of frac numbers."
+                  (check-success+ "lux frac =" (list subjectC paramC) Bool))
+            (test "Can compare frac numbers."
+                  (check-success+ "lux frac <" (list subjectC paramC) Bool))
+            (test "Can obtain minimum frac number."
+                  (check-success+ "lux frac min" (list) Frac))
+            (test "Can obtain maximum frac number."
+                  (check-success+ "lux frac max" (list) Frac))
+            (test "Can obtain smallest frac number."
+                  (check-success+ "lux frac smallest" (list) Frac))
+            (test "Can obtain not-a-number."
+                  (check-success+ "lux frac not-a-number" (list) Frac))
+            (test "Can obtain positive infinity."
+                  (check-success+ "lux frac positive-infinity" (list) Frac))
+            (test "Can obtain negative infinity."
+                  (check-success+ "lux frac negative-infinity" (list) Frac))
+            (test "Can convert frac number to integer."
+                  (check-success+ "lux frac to-int" (list subjectC) Int))
+            (test "Can convert frac number to degree."
+                  (check-success+ "lux frac to-deg" (list subjectC) Deg))
+            (test "Can convert frac number to text."
+                  (check-success+ "lux frac encode" (list subjectC) Text))
+            (test "Can convert text to frac number."
+                  (check-success+ "lux frac encode" (list encodedC) (type (Maybe Frac))))
+            ))))
 
 (context: "Text procedures"
-  [subjectC (|> (r;text +5) (:: @ map code;text))
-   paramC (|> (r;text +5) (:: @ map code;text))
-   replacementC (|> (r;text +5) (:: @ map code;text))
-   fromC (|> r;nat (:: @ map code;nat))
-   toC (|> r;nat (:: @ map code;nat))]
-  ($_ seq
-      (test "Can test text equality."
-            (check-success+ "lux text =" (list subjectC paramC) Bool))
-      (test "Compare texts in lexicographical order."
-            (check-success+ "lux text <" (list subjectC paramC) Bool))
-      (test "Can prepend one text to another."
-            (check-success+ "lux text prepend" (list subjectC paramC) Text))
-      (test "Can find the index of a piece of text inside a larger one that (may) contain it."
-            (check-success+ "lux text index" (list subjectC paramC fromC) (type (Maybe Nat))))
-      (test "Can query the size/length of a text."
-            (check-success+ "lux text size" (list subjectC) Nat))
-      (test "Can calculate a hash code for text."
-            (check-success+ "lux text hash" (list subjectC) Nat))
-      (test "Can replace a text inside of a larger one (once)."
-            (check-success+ "lux text replace-once" (list subjectC paramC replacementC) Text))
-      (test "Can replace a text inside of a larger one (all times)."
-            (check-success+ "lux text replace-all" (list subjectC paramC replacementC) Text))
-      (test "Can obtain the character code of a text at a given index."
-            (check-success+ "lux text char" (list subjectC fromC) Nat))
-      (test "Can clip a piece of text between 2 indices."
-            (check-success+ "lux text clip" (list subjectC fromC toC) Text))
-      ))
+  (<| (times +100)
+      (do @
+        [subjectC (|> (r;text +5) (:: @ map code;text))
+         paramC (|> (r;text +5) (:: @ map code;text))
+         replacementC (|> (r;text +5) (:: @ map code;text))
+         fromC (|> r;nat (:: @ map code;nat))
+         toC (|> r;nat (:: @ map code;nat))]
+        ($_ seq
+            (test "Can test text equality."
+                  (check-success+ "lux text =" (list subjectC paramC) Bool))
+            (test "Compare texts in lexicographical order."
+                  (check-success+ "lux text <" (list subjectC paramC) Bool))
+            (test "Can prepend one text to another."
+                  (check-success+ "lux text prepend" (list subjectC paramC) Text))
+            (test "Can find the index of a piece of text inside a larger one that (may) contain it."
+                  (check-success+ "lux text index" (list subjectC paramC fromC) (type (Maybe Nat))))
+            (test "Can query the size/length of a text."
+                  (check-success+ "lux text size" (list subjectC) Nat))
+            (test "Can calculate a hash code for text."
+                  (check-success+ "lux text hash" (list subjectC) Nat))
+            (test "Can replace a text inside of a larger one (once)."
+                  (check-success+ "lux text replace-once" (list subjectC paramC replacementC) Text))
+            (test "Can replace a text inside of a larger one (all times)."
+                  (check-success+ "lux text replace-all" (list subjectC paramC replacementC) Text))
+            (test "Can obtain the character code of a text at a given index."
+                  (check-success+ "lux text char" (list subjectC fromC) Nat))
+            (test "Can clip a piece of text between 2 indices."
+                  (check-success+ "lux text clip" (list subjectC fromC toC) Text))
+            ))))
 
 (context: "Array procedures"
-  [[elemT elemC] gen-primitive
-   sizeC (|> r;nat (:: @ map code;nat))
-   idxC (|> r;nat (:: @ map code;nat))
-   var-name (r;text +5)
-   #let [arrayT (type (Array elemT))]]
-  ($_ seq
-      (test "Can create arrays."
-            (check-success+ "lux array new" (list sizeC) arrayT))
-      (test "Can get a value inside an array."
-            (|> (&scope;with-scope ""
-                  (&scope;with-local [var-name arrayT]
-                    (&;with-expected-type elemT
-                      (@;analyse-procedure analyse "lux array get"
-                                           (list idxC
-                                                 (code;symbol ["" var-name]))))))
-                (meta;run (init-compiler []))
-                (case> (#e;Success _)
-                       true
+  (<| (times +100)
+      (do @
+        [[elemT elemC] gen-primitive
+         sizeC (|> r;nat (:: @ map code;nat))
+         idxC (|> r;nat (:: @ map code;nat))
+         var-name (r;text +5)
+         #let [arrayT (type (Array elemT))]]
+        ($_ seq
+            (test "Can create arrays."
+                  (check-success+ "lux array new" (list sizeC) arrayT))
+            (test "Can get a value inside an array."
+                  (|> (&scope;with-scope ""
+                        (&scope;with-local [var-name arrayT]
+                          (&;with-expected-type elemT
+                            (@;analyse-procedure analyse "lux array get"
+                                                 (list idxC
+                                                       (code;symbol ["" var-name]))))))
+                      (meta;run (init-compiler []))
+                      (case> (#e;Success _)
+                             true
 
-                       (#e;Error _)
-                       false)))
-      (test "Can put a value inside an array."
-            (|> (&scope;with-scope ""
-                  (&scope;with-local [var-name arrayT]
-                    (&;with-expected-type arrayT
-                      (@;analyse-procedure analyse "lux array put"
-                                           (list idxC
-                                                 elemC
-                                                 (code;symbol ["" var-name]))))))
-                (meta;run (init-compiler []))
-                (case> (#e;Success _)
-                       true
+                             (#e;Error _)
+                             false)))
+            (test "Can put a value inside an array."
+                  (|> (&scope;with-scope ""
+                        (&scope;with-local [var-name arrayT]
+                          (&;with-expected-type arrayT
+                            (@;analyse-procedure analyse "lux array put"
+                                                 (list idxC
+                                                       elemC
+                                                       (code;symbol ["" var-name]))))))
+                      (meta;run (init-compiler []))
+                      (case> (#e;Success _)
+                             true
 
-                       (#e;Error _)
-                       false)))
-      (test "Can remove a value from an array."
-            (|> (&scope;with-scope ""
-                  (&scope;with-local [var-name arrayT]
-                    (&;with-expected-type arrayT
-                      (@;analyse-procedure analyse "lux array remove"
-                                           (list idxC
-                                                 (code;symbol ["" var-name]))))))
-                (meta;run (init-compiler []))
-                (case> (#e;Success _)
-                       true
+                             (#e;Error _)
+                             false)))
+            (test "Can remove a value from an array."
+                  (|> (&scope;with-scope ""
+                        (&scope;with-local [var-name arrayT]
+                          (&;with-expected-type arrayT
+                            (@;analyse-procedure analyse "lux array remove"
+                                                 (list idxC
+                                                       (code;symbol ["" var-name]))))))
+                      (meta;run (init-compiler []))
+                      (case> (#e;Success _)
+                             true
 
-                       (#e;Error _)
-                       false)))
-      (test "Can query the size of an array."
-            (|> (&scope;with-scope ""
-                  (&scope;with-local [var-name arrayT]
-                    (&;with-expected-type Nat
-                      (@;analyse-procedure analyse "lux array size"
-                                           (list (code;symbol ["" var-name]))))))
-                (meta;run (init-compiler []))
-                (case> (#e;Success _)
-                       true
+                             (#e;Error _)
+                             false)))
+            (test "Can query the size of an array."
+                  (|> (&scope;with-scope ""
+                        (&scope;with-local [var-name arrayT]
+                          (&;with-expected-type Nat
+                            (@;analyse-procedure analyse "lux array size"
+                                                 (list (code;symbol ["" var-name]))))))
+                      (meta;run (init-compiler []))
+                      (case> (#e;Success _)
+                             true
 
-                       (#e;Error _)
-                       false)))
-      ))
+                             (#e;Error _)
+                             false)))
+            ))))
 
 (context: "Math procedures"
-  [subjectC (|> r;frac (:: @ map code;frac))
-   paramC (|> r;frac (:: @ map code;frac))]
-  (with-expansions [<unary> (do-template [<proc> <desc>]
-                              [(test (format "Can calculate " <desc> ".")
-                                     (check-success+ <proc> (list subjectC) Frac))]
+  (<| (times +100)
+      (do @
+        [subjectC (|> r;frac (:: @ map code;frac))
+         paramC (|> r;frac (:: @ map code;frac))]
+        (with-expansions [<unary> (do-template [<proc> <desc>]
+                                    [(test (format "Can calculate " <desc> ".")
+                                           (check-success+ <proc> (list subjectC) Frac))]
 
-                              ["lux math cos" "cosine"]
-                              ["lux math sin" "sine"]
-                              ["lux math tan" "tangent"]
-                              ["lux math acos" "inverse/arc cosine"]
-                              ["lux math asin" "inverse/arc sine"]
-                              ["lux math atan" "inverse/arc tangent"]
-                              ["lux math cosh" "hyperbolic cosine"]
-                              ["lux math sinh" "hyperbolic sine"]
-                              ["lux math tanh" "hyperbolic tangent"]
-                              ["lux math exp" "exponentiation"]
-                              ["lux math log" "logarithm"]
-                              ["lux math root2" "square root"]
-                              ["lux math root3" "cubic root"]
-                              ["lux math ceil" "ceiling"]
-                              ["lux math floor" "floor"]
-                              ["lux math round" "rounding"])
-                    <binary> (do-template [<proc> <desc>]
-                               [(test (format "Can calculate " <desc> ".")
-                                      (check-success+ <proc> (list subjectC paramC) Frac))]
+                                    ["lux math cos" "cosine"]
+                                    ["lux math sin" "sine"]
+                                    ["lux math tan" "tangent"]
+                                    ["lux math acos" "inverse/arc cosine"]
+                                    ["lux math asin" "inverse/arc sine"]
+                                    ["lux math atan" "inverse/arc tangent"]
+                                    ["lux math cosh" "hyperbolic cosine"]
+                                    ["lux math sinh" "hyperbolic sine"]
+                                    ["lux math tanh" "hyperbolic tangent"]
+                                    ["lux math exp" "exponentiation"]
+                                    ["lux math log" "logarithm"]
+                                    ["lux math root2" "square root"]
+                                    ["lux math root3" "cubic root"]
+                                    ["lux math ceil" "ceiling"]
+                                    ["lux math floor" "floor"]
+                                    ["lux math round" "rounding"])
+                          <binary> (do-template [<proc> <desc>]
+                                     [(test (format "Can calculate " <desc> ".")
+                                            (check-success+ <proc> (list subjectC paramC) Frac))]
 
-                               ["lux math atan2" "inverse/arc tangent (with 2 arguments)"]
-                               ["lux math pow" "power"])]
-    ($_ seq
-        <unary>
-        <binary>)))
+                                     ["lux math atan2" "inverse/arc tangent (with 2 arguments)"]
+                                     ["lux math pow" "power"])]
+          ($_ seq
+              <unary>
+              <binary>)))))
 
 (context: "Atom procedures"
-  [[elemT elemC] gen-primitive
-   sizeC (|> r;nat (:: @ map code;nat))
-   idxC (|> r;nat (:: @ map code;nat))
-   var-name (r;text +5)
-   #let [atomT (type (atom;Atom elemT))]]
-  ($_ seq
-      (test "Can create atomic reference."
-            (check-success+ "lux atom new" (list elemC) atomT))
-      (test "Can read the value of an atomic reference."
-            (|> (&scope;with-scope ""
-                  (&scope;with-local [var-name atomT]
-                    (&;with-expected-type elemT
-                      (@;analyse-procedure analyse "lux atom read"
-                                           (list (code;symbol ["" var-name]))))))
-                (meta;run (init-compiler []))
-                (case> (#e;Success _)
-                       true
+  (<| (times +100)
+      (do @
+        [[elemT elemC] gen-primitive
+         sizeC (|> r;nat (:: @ map code;nat))
+         idxC (|> r;nat (:: @ map code;nat))
+         var-name (r;text +5)
+         #let [atomT (type (atom;Atom elemT))]]
+        ($_ seq
+            (test "Can create atomic reference."
+                  (check-success+ "lux atom new" (list elemC) atomT))
+            (test "Can read the value of an atomic reference."
+                  (|> (&scope;with-scope ""
+                        (&scope;with-local [var-name atomT]
+                          (&;with-expected-type elemT
+                            (@;analyse-procedure analyse "lux atom read"
+                                                 (list (code;symbol ["" var-name]))))))
+                      (meta;run (init-compiler []))
+                      (case> (#e;Success _)
+                             true
 
-                       (#e;Error _)
-                       false)))
-      (test "Can swap the value of an atomic reference."
-            (|> (&scope;with-scope ""
-                  (&scope;with-local [var-name atomT]
-                    (&;with-expected-type Bool
-                      (@;analyse-procedure analyse "lux atom compare-and-swap"
-                                           (list elemC
-                                                 elemC
-                                                 (code;symbol ["" var-name]))))))
-                (meta;run (init-compiler []))
-                (case> (#e;Success _)
-                       true
+                             (#e;Error _)
+                             false)))
+            (test "Can swap the value of an atomic reference."
+                  (|> (&scope;with-scope ""
+                        (&scope;with-local [var-name atomT]
+                          (&;with-expected-type Bool
+                            (@;analyse-procedure analyse "lux atom compare-and-swap"
+                                                 (list elemC
+                                                       elemC
+                                                       (code;symbol ["" var-name]))))))
+                      (meta;run (init-compiler []))
+                      (case> (#e;Success _)
+                             true
 
-                       (#e;Error _)
-                       false)))
-      ))
+                             (#e;Error _)
+                             false)))
+            ))))
 
 (context: "Process procedures"
-  [[primT primC] gen-primitive
-   timeC (|> r;nat (:: @ map code;nat))]
-  ($_ seq
-      (test "Can query the level of concurrency."
-            (check-success+ "lux process concurrency-level" (list) Nat))
-      (test "Can run an IO computation concurrently."
-            (check-success+ "lux process future"
-                            (list (` ((~' _lux_function) (~' _) (~' _) (~ primC))))
-                            Unit))
-      (test "Can schedule an IO computation to run concurrently at some future time."
-            (check-success+ "lux process schedule"
-                            (list timeC
-                                  (` ((~' _lux_function) (~' _) (~' _) (~ primC))))
-                            Unit))
-      ))
+  (<| (times +100)
+      (do @
+        [[primT primC] gen-primitive
+         timeC (|> r;nat (:: @ map code;nat))]
+        ($_ seq
+            (test "Can query the level of concurrency."
+                  (check-success+ "lux process concurrency-level" (list) Nat))
+            (test "Can run an IO computation concurrently."
+                  (check-success+ "lux process future"
+                                  (list (` ((~' _lux_function) (~' _) (~' _) (~ primC))))
+                                  Unit))
+            (test "Can schedule an IO computation to run concurrently at some future time."
+                  (check-success+ "lux process schedule"
+                                  (list timeC
+                                        (` ((~' _lux_function) (~' _) (~' _) (~ primC))))
+                                  Unit))
+            ))))
 
 (context: "IO procedures"
-  [logC (|> (r;text +5) (:: @ map code;text))
-   exitC (|> r;nat (:: @ map code;nat))]
-  ($_ seq
-      (test "Can log messages to standard output."
-            (check-success+ "lux io log" (list logC) Unit))
-      (test "Can log messages to standard output."
-            (check-success+ "lux io error" (list logC) Bottom))
-      (test "Can log messages to standard output."
-            (check-success+ "lux io exit" (list exitC) Bottom))
-      (test "Can query the current time (as milliseconds since epoch)."
-            (check-success+ "lux io current-time" (list) Int))
-      ))
+  (<| (times +100)
+      (do @
+        [logC (|> (r;text +5) (:: @ map code;text))
+         exitC (|> r;nat (:: @ map code;nat))]
+        ($_ seq
+            (test "Can log messages to standard output."
+                  (check-success+ "lux io log" (list logC) Unit))
+            (test "Can log messages to standard output."
+                  (check-success+ "lux io error" (list logC) Bottom))
+            (test "Can log messages to standard output."
+                  (check-success+ "lux io exit" (list exitC) Bottom))
+            (test "Can query the current time (as milliseconds since epoch)."
+                  (check-success+ "lux io current-time" (list) Int))
+            ))))