- Migrated primitive analysis to stdlib.

1 files changed, 63 insertions, 0 deletions

diff --git a/stdlib/test/test/lux/lang/analysis/primitive.lux b/stdlib/test/test/lux/lang/analysis/primitive.lux
new file mode 100644
index 000000000..2e7c2057a
--- /dev/null
+++ b/stdlib/test/test/lux/lang/analysis/primitive.lux
@@ -0,0 +1,63 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe
+                ["ex" exception #+ exception:])
+       (data (text format)
+             ["e" error])
+       ["r" math/random]
+       [macro]
+       (macro [code])
+       (lang [".L" type "type/" Eq<Type>]
+             [".L" init]
+             [analysis #+ Analysis]
+             (analysis [".A" type]
+                       ["/" primitive]))
+       test))
+
+(exception: (wrong-inference {expected Type} {inferred Type})
+  (format "Expected: " (%type expected) "\n"
+          "Inferred: " (%type inferred) "\n"))
+
+(def: (infer-primitive expected-type analysis)
+  (-> Type (Meta Analysis) (e.Error Analysis))
+  (|> (typeA.with-inference
+        analysis)
+      (macro.run (initL.compiler []))
+      (case> (#e.Success [inferred-type output])
+             (if (is? expected-type inferred-type)
+               (#e.Success output)
+               (ex.throw wrong-inference [expected-type inferred-type]))
+
+             (#e.Error error)
+             (#e.Error error))))
+
+(context: "Primitives"
+  (<| (times +100)
+      (`` ($_ seq
+              (test "Can analyse unit."
+                    (|> (infer-primitive Top /.unit)
+                        (case> (^ (#e.Success (#analysis.Primitive (#analysis.Unit output))))
+                               (is? [] output)
+
+                               _
+                               false)))
+              (~~ (do-template [<desc> <type> <tag> <random> <analyser>]
+                    [(do @
+                       [sample <random>]
+                       (test (format "Can analyse " <desc> ".")
+                             (|> (infer-primitive <type> (<analyser> sample))
+                                 (case> (#e.Success (#analysis.Primitive (<tag> output)))
+                                        (is? sample output)
+
+                                        _
+                                        false))))]
+
+                    ["bool" Bool #analysis.Bool r.bool /.bool]
+                    ["nat"  Nat  #analysis.Nat  r.nat  /.nat]
+                    ["int"  Int  #analysis.Int  r.int  /.int]
+                    ["deg"  Deg  #analysis.Deg  r.deg  /.deg]
+                    ["frac" Frac #analysis.Frac r.frac /.frac]
+                    ["text" Text #analysis.Text (r.unicode +5) /.text]
+                    ))))))