- Migrated special-form analysis to stdlib.

2 files changed, 120 insertions, 133 deletions

diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux b/stdlib/test/test/lux/lang/analysis/procedure/common.lux
index fba355a79..898376045 100644
--- a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
+++ b/stdlib/test/test/lux/lang/analysis/procedure/common.lux
@@ -11,25 +11,21 @@
        ["r" math/random "r/" Monad<Random>]
        [macro #+ Monad<Meta>]
        (macro [code])
-       (lang [type "type/" Eq<Type>])
+       [lang]
+       (lang [type "type/" Eq<Type>]
+             [".L" scope]
+             [".L" init]
+             (analysis [".A" type]))
        test)
-  (luxc ["&" lang]
-        (lang ["&." scope]
-              ["&." module]
-              ["~" analysis]
-              (analysis [".A" expression]
-                        ["@." common])
-              [".L" eval]))
-  (/// common)
-  (test/luxc common))
+  (/// ["_." primitive]))
 
 (do-template [<name> <success> <failure>]
   [(def: (<name> procedure params output-type)
      (-> Text (List Code) Type Bool)
-     (|> (&.with-scope
-           (&.with-type output-type
-             (analyse (` ((~ (code.text procedure)) (~+ params))))))
-         (macro.run (io.run init-jvm))
+     (|> (lang.with-scope
+           (typeA.with-type output-type
+             (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))
+         (macro.run (initL.compiler []))
          (case> (#e.Success _)
                 <success>
 
@@ -43,8 +39,8 @@
 (context: "Lux procedures"
   (<| (times +100)
       (do @
-        [[primT primC] gen-primitive
-         [antiT antiC] (|> gen-primitive
+        [[primT primC] _primitive.primitive
+         [antiT antiC] (|> _primitive.primitive
                            (r.filter (|>> product.left (type/= primT) not)))]
         ($_ seq
             (test "Can test for reference equality."
@@ -64,8 +60,6 @@
          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'."
@@ -117,7 +111,7 @@
       (do @
         [subjectC (|> r.frac (:: @ map code.frac))
          paramC (|> r.frac (:: @ map code.frac))
-         encodedC (|> (r.text +5) (:: @ map code.text))]
+         encodedC (|> (r.unicode +5) (:: @ map code.text))]
         ($_ seq
             (test "Can add frac numbers."
                   (check-success+ "lux frac +" (list subjectC paramC) Frac))
@@ -156,9 +150,9 @@
 (context: "Text procedures"
   (<| (times +100)
       (do @
-        [subjectC (|> (r.text +5) (:: @ map code.text))
-         paramC (|> (r.text +5) (:: @ map code.text))
-         replacementC (|> (r.text +5) (:: @ map code.text))
+        [subjectC (|> (r.unicode +5) (:: @ map code.text))
+         paramC (|> (r.unicode +5) (:: @ map code.text))
+         replacementC (|> (r.unicode +5) (:: @ map code.text))
          fromC (|> r.nat (:: @ map code.nat))
          toC (|> r.nat (:: @ map code.nat))]
         ($_ seq
@@ -187,18 +181,18 @@
 (context: "Array procedures"
   (<| (times +100)
       (do @
-        [[elemT elemC] gen-primitive
+        [[elemT elemC] _primitive.primitive
          sizeC (|> r.nat (:: @ map code.nat))
          idxC (|> r.nat (:: @ map code.nat))
-         var-name (r.text +5)
+         var-name (r.unicode +5)
          #let [arrayT (type (Array elemT))
                g!array (code.local-symbol var-name)
                array-operation (function (_ output-type code)
-                                 (|> (&scope.with-scope ""
-                                       (&scope.with-local [var-name arrayT]
-                                         (&.with-type output-type
-                                           (analyse code))))
-                                     (macro.run (io.run init-jvm))
+                                 (|> (scopeL.with-scope ""
+                                       (scopeL.with-local [var-name arrayT]
+                                         (typeA.with-type output-type
+                                           (_primitive.analyse code))))
+                                     (macro.run (initL.compiler []))
                                      (case> (#e.Success _)
                                             true
 
@@ -226,65 +220,63 @@
       (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))]
+        (`` ($_ seq
+                (~~ (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 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 ceil" "ceiling"]
+                      ["lux math floor" "floor"]
+                      ["lux math round" "rounding"]))
+                (~~ (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"])))))))
 
 (context: "Atom procedures"
   (<| (times +100)
       (do @
-        [[elemT elemC] gen-primitive
+        [[elemT elemC] _primitive.primitive
          sizeC (|> r.nat (:: @ map code.nat))
          idxC (|> r.nat (:: @ map code.nat))
-         var-name (r.text +5)
+         var-name (r.unicode +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-type elemT
-                            (analyse (` ("lux atom read" (~ (code.symbol ["" var-name]))))))))
-                      (macro.run (io.run init-jvm))
+                  (|> (scopeL.with-scope ""
+                        (scopeL.with-local [var-name atomT]
+                          (typeA.with-type elemT
+                            (_primitive.analyse (` ("lux atom read" (~ (code.symbol ["" var-name]))))))))
+                      (macro.run (initL.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-type Bool
-                            (analyse (` ("lux atom compare-and-swap"
-                                         (~ (code.symbol ["" var-name]))
-                                         (~ elemC)
-                                         (~ elemC)))))))
-                      (macro.run (io.run init-jvm))
+                  (|> (scopeL.with-scope ""
+                        (scopeL.with-local [var-name atomT]
+                          (typeA.with-type Bool
+                            (_primitive.analyse (` ("lux atom compare-and-swap"
+                                                    (~ (code.symbol ["" var-name]))
+                                                    (~ elemC)
+                                                    (~ elemC)))))))
+                      (macro.run (initL.compiler []))
                       (case> (#e.Success _)
                              true
 
@@ -295,7 +287,7 @@
 (context: "Process procedures"
   (<| (times +100)
       (do @
-        [[primT primC] gen-primitive
+        [[primT primC] _primitive.primitive
          timeC (|> r.nat (:: @ map code.nat))]
         ($_ seq
             (test "Can query the level of concurrency."
@@ -310,7 +302,7 @@
 (context: "IO procedures"
   (<| (times +100)
       (do @
-        [logC (|> (r.text +5) (:: @ map code.text))
+        [logC (|> (r.unicode +5) (:: @ map code.text))
          exitC (|> r.int (:: @ map code.int))]
         ($_ seq
             (test "Can log messages to standard output."
diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux b/stdlib/test/test/lux/lang/analysis/procedure/host.jvm.lux
index 3d0c76777..0a60149d5 100644
--- a/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux
+++ b/stdlib/test/test/lux/lang/analysis/procedure/host.jvm.lux
@@ -15,31 +15,25 @@
        ["r" math/random "r/" Monad<Random>]
        [macro #+ Monad<Meta>]
        (macro [code])
-       (lang [type])
+       [lang]
+       (lang [type]
+             [".L" init]
+             (analysis [".A" type])
+             (extension (analysis [".AE" host])))
        test)
-  (luxc ["&" lang]
-        (lang ["&." scope]
-              ["&." module]
-              ["~" analysis]
-              (analysis [".A" expression]
-                        ["@." common])
-              (translation (jvm ["@." runtime]))
-              (extension (analysis ["@." host]))
-              [".L" eval]))
-  (/// common)
-  (test/luxc common))
+  (/// ["_." primitive]))
 
 (do-template [<name> <success> <failure>]
   [(def: (<name> procedure params output-type)
      (-> Text (List Code) Type Bool)
      (|> (do Monad<Meta>
-           [runtime-bytecode @runtime.translate]
-           (&.with-scope
-             (&.with-type output-type
-               ((expressionA.analyser evalL.eval)
-                (` ((~ (code.text procedure)) (~+ params)))))))
-         (&.with-current-module "")
-         (macro.run (io.run init-jvm))
+           [## runtime-bytecode @runtime.translate
+            ]
+           (lang.with-scope
+             (typeA.with-type output-type
+               (_primitive.analyse (` ((~ (code.text procedure)) (~+ params)))))))
+         (lang.with-current-module "")
+         (macro.run (initL.compiler []))
          (case> (#e.Success _)
                 <success>
 
@@ -54,12 +48,13 @@
   [(def: (<name> syntax output-type)
      (-> Code Type Bool)
      (|> (do Monad<Meta>
-           [runtime-bytecode @runtime.translate]
-           (&.with-scope
-             (&.with-type output-type
-               (expressionA.analyser evalL.eval syntax))))
-         (&.with-current-module "")
-         (macro.run (io.run init-jvm))
+           [## runtime-bytecode @runtime.translate
+            ]
+           (lang.with-scope
+             (typeA.with-type output-type
+               (_primitive.analyse syntax))))
+         (lang.with-current-module "")
+         (macro.run (initL.compiler []))
          (case> (#e.Success _)
                 <success>
 
@@ -77,12 +72,12 @@
                                      (test (format <procedure> " FAILURE")
                                            (failure <procedure> (list (' [])) <to>))]
 
-                                    ["jvm convert double-to-float" "java.lang.Double" @host.Float]
-                                    ["jvm convert double-to-int" "java.lang.Double" @host.Integer]
-                                    ["jvm convert double-to-long" "java.lang.Double" @host.Long]
-                                    ["jvm convert float-to-double" "java.lang.Float" @host.Double]
-                                    ["jvm convert float-to-int" "java.lang.Float" @host.Integer]
-                                    ["jvm convert float-to-long" "java.lang.Float" @host.Long]
+                                    ["jvm convert double-to-float" "java.lang.Double" hostAE.Float]
+                                    ["jvm convert double-to-int" "java.lang.Double" hostAE.Integer]
+                                    ["jvm convert double-to-long" "java.lang.Double" hostAE.Long]
+                                    ["jvm convert float-to-double" "java.lang.Float" hostAE.Double]
+                                    ["jvm convert float-to-int" "java.lang.Float" hostAE.Integer]
+                                    ["jvm convert float-to-long" "java.lang.Float" hostAE.Long]
                                     )]
     ($_ seq
         <conversions>
@@ -95,12 +90,12 @@
                                      (test (format <procedure> " FAILURE")
                                            (failure <procedure> (list (' [])) <to>))]
 
-                                    ["jvm convert int-to-byte" "java.lang.Integer" @host.Byte]
-                                    ["jvm convert int-to-char" "java.lang.Integer" @host.Character]
-                                    ["jvm convert int-to-double" "java.lang.Integer" @host.Double]
-                                    ["jvm convert int-to-float" "java.lang.Integer" @host.Float]
-                                    ["jvm convert int-to-long" "java.lang.Integer" @host.Long]
-                                    ["jvm convert int-to-short" "java.lang.Integer" @host.Short]
+                                    ["jvm convert int-to-byte" "java.lang.Integer" hostAE.Byte]
+                                    ["jvm convert int-to-char" "java.lang.Integer" hostAE.Character]
+                                    ["jvm convert int-to-double" "java.lang.Integer" hostAE.Double]
+                                    ["jvm convert int-to-float" "java.lang.Integer" hostAE.Float]
+                                    ["jvm convert int-to-long" "java.lang.Integer" hostAE.Long]
+                                    ["jvm convert int-to-short" "java.lang.Integer" hostAE.Short]
                                     )]
     ($_ seq
         <conversions>
@@ -113,11 +108,11 @@
                                      (test (format <procedure> " FAILURE")
                                            (failure <procedure> (list (' [])) <to>))]
 
-                                    ["jvm convert long-to-double" "java.lang.Long" @host.Double]
-                                    ["jvm convert long-to-float" "java.lang.Long" @host.Float]
-                                    ["jvm convert long-to-int" "java.lang.Long" @host.Integer]
-                                    ["jvm convert long-to-short" "java.lang.Long" @host.Short]
-                                    ["jvm convert long-to-byte" "java.lang.Long" @host.Byte]
+                                    ["jvm convert long-to-double" "java.lang.Long" hostAE.Double]
+                                    ["jvm convert long-to-float" "java.lang.Long" hostAE.Float]
+                                    ["jvm convert long-to-int" "java.lang.Long" hostAE.Integer]
+                                    ["jvm convert long-to-short" "java.lang.Long" hostAE.Short]
+                                    ["jvm convert long-to-byte" "java.lang.Long" hostAE.Byte]
                                     )]
     ($_ seq
         <conversions>
@@ -130,12 +125,12 @@
                                      (test (format <procedure> " FAILURE")
                                            (failure <procedure> (list (' [])) <to>))]
 
-                                    ["jvm convert char-to-byte" "java.lang.Character" @host.Byte]
-                                    ["jvm convert char-to-short" "java.lang.Character" @host.Short]
-                                    ["jvm convert char-to-int" "java.lang.Character" @host.Integer]
-                                    ["jvm convert char-to-long" "java.lang.Character" @host.Long]
-                                    ["jvm convert byte-to-long" "java.lang.Byte" @host.Long]
-                                    ["jvm convert short-to-long" "java.lang.Short" @host.Long]
+                                    ["jvm convert char-to-byte" "java.lang.Character" hostAE.Byte]
+                                    ["jvm convert char-to-short" "java.lang.Character" hostAE.Short]
+                                    ["jvm convert char-to-int" "java.lang.Character" hostAE.Integer]
+                                    ["jvm convert char-to-long" "java.lang.Character" hostAE.Long]
+                                    ["jvm convert byte-to-long" "java.lang.Byte" hostAE.Long]
+                                    ["jvm convert short-to-long" "java.lang.Short" hostAE.Long]
                                     )]
     ($_ seq
         <conversions>
@@ -168,8 +163,8 @@
                                                               (' ("lux coerce" (+0 <param> (+0)) [])))
                                                         <output>))]
 
-                                        [(format "jvm " <domain> " =") <boxed> <boxed> @host.Boolean]
-                                        [(format "jvm " <domain> " <") <boxed> <boxed> @host.Boolean]
+                                        [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
                                         )]
        ($_ seq
            <instructions>
@@ -195,8 +190,8 @@
            )))]
 
 
-  ["int" "java.lang.Integer" @host.Integer]
-  ["long" "java.lang.Long" @host.Long]
+  ["int" "java.lang.Integer" hostAE.Integer]
+  ["long" "java.lang.Long" hostAE.Long]
   )
 
 (do-template [<domain> <boxed> <type>]
@@ -226,16 +221,16 @@
                                                               (' ("lux coerce" (+0 <param> (+0)) [])))
                                                         <output>))]
 
-                                        [(format "jvm " <domain> " =") <boxed> <boxed> @host.Boolean]
-                                        [(format "jvm " <domain> " <") <boxed> <boxed> @host.Boolean]
+                                        [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
                                         )]
        ($_ seq
            <instructions>
            )))]
 
 
-  ["float" "java.lang.Float" @host.Float]
-  ["double" "java.lang.Double" @host.Double]
+  ["float" "java.lang.Float" hostAE.Float]
+  ["double" "java.lang.Double" hostAE.Double]
   )
 
 (do-template [<domain> <boxed> <type>]
@@ -247,23 +242,23 @@
                                                               (' ("lux coerce" (+0 <param> (+0)) [])))
                                                         <output>))]
 
-                                        [(format "jvm " <domain> " =") <boxed> <boxed> @host.Boolean]
-                                        [(format "jvm " <domain> " <") <boxed> <boxed> @host.Boolean]
+                                        [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
                                         )]
        ($_ seq
            <instructions>
            )))]
 
 
-  ["char" "java.lang.Character" @host.Character]
+  ["char" "java.lang.Character" hostAE.Character]
   )
 
 (def: array-type
   (r.Random [Text Text])
-  (let [entries (dict.entries @host.boxes)
+  (let [entries (dict.entries hostAE.boxes)
         num-entries (list.size entries)]
     (do r.Monad<Random>
-      [choice (|> r.nat (:: @ map (n/% (n/inc num-entries))))
+      [choice (|> r.nat (:: @ map (n/% (inc num-entries))))
        #let [[unboxed boxed] (: [Text Text]
                                 (|> entries
                                     (list.nth choice)
@@ -340,7 +335,7 @@
                unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0))
                              ("jvm object null")))]
          throwable (|> r.nat
-                       (:: @ map (n/% (n/inc (list.size throwables))))
+                       (:: @ map (n/% (inc (list.size throwables))))
                        (:: @ map (function (_ idx)
                                    (|> throwables
                                        (list.nth idx)