From 1ea83ecadccc5adee1bdb35bd11527c3982c015e Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 21 Aug 2021 04:06:54 -0400
Subject: Can now produce arbitrary code fragments statically by evaluating
 arbitrary expressions at compile-time.

---
 stdlib/source/test/lux.lux               |  2 +
 stdlib/source/test/lux/documentation.lux | 36 ++++++++++-----
 stdlib/source/test/lux/static.lux        | 76 ++++++++++++++++++++++++++++++++
 3 files changed, 103 insertions(+), 11 deletions(-)
 create mode 100644 stdlib/source/test/lux/static.lux

(limited to 'stdlib/source/test')

diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 6eab1c60b..68f155559 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -56,6 +56,7 @@
      ["#." math]
      ["#." meta]
      ["#." program]
+     ["#." static]
      ["#." target]
      ["#." test]
      ["#." time]
@@ -93,6 +94,7 @@
                              
                              /meta.test
                              /program.test
+                             /static.test
                              /target.test
                              /test.test
 
diff --git a/stdlib/source/test/lux/documentation.lux b/stdlib/source/test/lux/documentation.lux
index 6efd24021..bf7c312c9 100644
--- a/stdlib/source/test/lux/documentation.lux
+++ b/stdlib/source/test/lux/documentation.lux
@@ -52,7 +52,8 @@
                      (_.for [/.Definition]
                             ($_ _.and
                                 (_.cover [/.default]
-                                         (let [definition (`` (/.default (~~ (template.identifier [.._] [g!default]))))]
+                                         (case (`` (/.default (~~ (template.identifier [.._] [g!default]))))
+                                           (^ (list definition))
                                            (and (|> definition
                                                     (value@ #/.definition)
                                                     (text\= (template.text [g!default])))
@@ -60,15 +61,23 @@
                                                     (value@ #/.documentation)
                                                     md.markdown
                                                     (text\= "")
-                                                    not))))
+                                                    not))
+
+                                           _
+                                           false))
                                 (_.cover [/.documentation:]
-                                         (and (|> ..documentation:
-                                                  (value@ #/.definition)
-                                                  (text\= (template.text [/.documentation:])))
-                                              (|> ..documentation:
-                                                  (value@ #/.documentation)
-                                                  md.markdown
-                                                  (text.contains? 'definition_description'))))
+                                         (case ..documentation:
+                                           (^ (list documentation:))
+                                           (and (|> documentation:
+                                                    (value@ #/.definition)
+                                                    (text\= (template.text [/.documentation:])))
+                                                (|> documentation:
+                                                    (value@ #/.documentation)
+                                                    md.markdown
+                                                    (text.contains? 'definition_description')))
+
+                                           _
+                                           false))
                                 ))
                      (_.for [/.Module]
                             ($_ _.and
@@ -87,8 +96,13 @@
                                                                 (/.documentation super))
                                                 (text.contains? (template.text ['super_description'])
                                                                 (/.documentation super))
-                                                (text.contains? (md.markdown (value@ #/.documentation ..documentation:))
-                                                                (/.documentation super)))))
+                                                (case ..documentation:
+                                                  (^ (list documentation:))
+                                                  (text.contains? (md.markdown (value@ #/.documentation documentation:))
+                                                                  (/.documentation super))
+
+                                                  _
+                                                  false))))
                                 ))
                      (_.cover [/.unqualified_identifier]
                               (`` (and (~~ (template [<example>]
diff --git a/stdlib/source/test/lux/static.lux b/stdlib/source/test/lux/static.lux
new file mode 100644
index 000000000..d54751f43
--- /dev/null
+++ b/stdlib/source/test/lux/static.lux
@@ -0,0 +1,76 @@
+(.module:
+  [library
+   [lux #*
+    ["_" test (#+ Test)]
+    ["." meta]
+    [data
+     ["." text ("#\." equivalence)
+      ["%" format (#+ format)]]]
+    [macro
+     ["." code]]
+    [math
+     ["." random]
+     [number
+      ["n" nat]
+      ["i" int]
+      ["r" rev]
+      ["f" frac]]]]]
+  [\\library
+   ["." /]])
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (_.for [meta.eval])
+      (`` ($_ _.and
+              (~~ (template [<static> <random> <=> <+> <tag>]
+                    [(_.cover [<static> <random>]
+                              (with_expansions [<left> (<random>)
+                                                <right> (<random>)
+                                                <l+r> (<static> (<+> <left> <right>))]
+                                (case (' <l+r>)
+                                  [_ (<tag> l+r)]
+                                  (<=> l+r (<+> <left> <right>))
+
+                                  _
+                                  false)))]
+
+                    [/.nat /.random_nat n.= n.+ #.Nat]
+                    [/.int /.random_int i.= i.+ #.Int]
+                    [/.rev /.random_rev r.= r.+ #.Rev]
+                    ))
+              (_.cover [/.frac /.random_frac]
+                       (with_expansions [<left> (/.random_frac)
+                                         <right> (/.random_frac)
+                                         <l+r> (/.frac (f.+ <left> <right>))]
+                         (case (' <l+r>)
+                           [_ (#.Frac l+r)]
+                           (or (f.= l+r (f.+ <left> <right>))
+                               (and (f.not_a_number? l+r)
+                                    (f.not_a_number? (f.+ <left> <right>))
+                                    (or (f.not_a_number? <left>)
+                                        (f.not_a_number? <right>))))
+
+                           _
+                           false)))
+              (_.cover [/.text /.random]
+                       (with_expansions [<left> (/.random code.text (random.ascii/alpha_num 1))
+                                         <right> (/.random code.text (random.ascii/alpha_num 1))
+                                         <l+r> (/.text (format <left> <right>))]
+                         (case (' <l+r>)
+                           [_ (#.Text l+r)]
+                           (text\= l+r (format <left> <right>))
+
+                           _
+                           false)))
+              (_.cover [/.literal]
+                       (with_expansions [<left> (/.random code.text (random.ascii/alpha_num 1))
+                                         <right> (/.random code.text (random.ascii/alpha_num 1))
+                                         <l+r> (/.literal code.text (format <left> <right>))]
+                         (case (' <l+r>)
+                           [_ (#.Text l+r)]
+                           (text\= l+r (format <left> <right>))
+
+                           _
+                           false)))
+              ))))
-- 
cgit v1.2.3