- Migrated new-luxc to latest version of stdlib.

- Some refactoring.

3 files changed, 82 insertions, 81 deletions

diff --git a/new-luxc/source/luxc/analyser/procedure.lux b/new-luxc/source/luxc/analyser/procedure.lux
index 064a28e9b..23fbae198 100644
--- a/new-luxc/source/luxc/analyser/procedure.lux
+++ b/new-luxc/source/luxc/analyser/procedure.lux
@@ -1,23 +1,23 @@
 (;module:
   lux
   (lux (control [monad #+ do])
-       (data [text]
+       (data [maybe]
+             [text]
              text/format
-             (coll ["d" dict])
-             [maybe]))
+             (coll [dict])))
   (luxc ["&" base]
-        (lang ["la" analysis #+ Analysis]))
+        (lang ["la" analysis]))
   (. ["./;" common]
      ["./;" host]))
 
 (def: procedures
   ./common;Bundle
   (|> ./common;procedures
-      (d;merge ./host;procedures)))
+      (dict;merge ./host;procedures)))
 
 (def: #export (analyse-procedure analyse proc-name proc-args)
-  (-> &;Analyser Text (List Code) (Lux Analysis))
-  (default (&;fail (format "Unknown procedure: " (%t proc-name)))
-           (do maybe;Monad<Maybe>
-             [proc (d;get proc-name procedures)]
-             (wrap (proc analyse proc-args)))))
+  (-> &;Analyser Text (List Code) (Lux la;Analysis))
+  (<| (maybe;default (&;fail (format "Unknown procedure: " (%t proc-name))))
+      (do maybe;Monad<Maybe>
+        [proc (dict;get proc-name procedures)]
+        (wrap (proc analyse proc-args)))))
diff --git a/new-luxc/source/luxc/analyser/procedure/common.lux b/new-luxc/source/luxc/analyser/procedure/common.lux
index ffb87a2ca..a0f739f3b 100644
--- a/new-luxc/source/luxc/analyser/procedure/common.lux
+++ b/new-luxc/source/luxc/analyser/procedure/common.lux
@@ -6,32 +6,32 @@
              text/format
              (coll [list "list/" Functor<List>]
                    [array #+ Array]
-                   ["d" dict]))
+                   [dict #+ Dict]))
        [macro #+ Monad<Lux>]
-       (type ["TC" check])
+       (type ["tc" check])
        [io])
   (luxc ["&" base]
-        (lang ["la" analysis #+ Analysis])
+        (lang ["la" analysis])
         (analyser ["&;" common])))
 
 ## [Utils]
 (type: #export Proc
-  (-> &;Analyser (List Code) (Lux Analysis)))
+  (-> &;Analyser (List Code) (Lux la;Analysis)))
 
 (type: #export Bundle
-  (d;Dict Text Proc))
+  (Dict Text Proc))
 
 (def: #export (install name unnamed)
   (-> Text (-> Text Proc)
       (-> Bundle Bundle))
-  (d;put name (unnamed name)))
+  (dict;put name (unnamed name)))
 
 (def: #export (prefix prefix bundle)
   (-> Text Bundle Bundle)
   (|> bundle
-      d;entries
+      dict;entries
       (list/map (function [[key val]] [(format prefix " " key) val]))
-      (d;from-list text;Hash<Text>)))
+      (dict;from-list text;Hash<Text>)))
 
 (def: #export (wrong-arity proc expected actual)
   (-> Text Nat Nat Text)
@@ -52,8 +52,8 @@
                                   (analyse argC)))
                               (list;zip2 input-types args))
              expected macro;expected-type
-             _ (&;within-type-env
-                (TC;check expected output-type))]
+             _ (&;with-type-env
+                 (tc;check expected output-type))]
             (wrap (#la;Procedure proc argsA)))
           (&;fail (wrong-arity proc num-expected num-actual)))))))
 
@@ -95,11 +95,11 @@
           (do Monad<Lux>
             [opA (&;with-expected-type (type (io;IO varT))
                    (analyse opC))
-             outputT (&;within-type-env
-                      (TC;clean var-id (type (Either Text varT))))
+             outputT (&;with-type-env
+                       (tc;clean var-id (type (Either Text varT))))
              expected macro;expected-type
-             _ (&;within-type-env
-                (TC;check expected outputT))]
+             _ (&;with-type-env
+                 (tc;check expected outputT))]
             (wrap (#la;Procedure proc (list opA))))
           
           _
@@ -107,14 +107,14 @@
 
 (def: lux-procs
   Bundle
-  (|> (d;new text;Hash<Text>)
+  (|> (dict;new text;Hash<Text>)
       (install "is" lux-is)
       (install "try" lux-try)))
 
 (def: io-procs
   Bundle
   (<| (prefix "io")
-      (|> (d;new text;Hash<Text>)
+      (|> (dict;new text;Hash<Text>)
           (install "log" (unary Text Unit))
           (install "error" (unary Text Bottom))
           (install "exit" (unary Nat Bottom))
@@ -123,7 +123,7 @@
 (def: bit-procs
   Bundle
   (<| (prefix "bit")
-      (|> (d;new text;Hash<Text>)
+      (|> (dict;new text;Hash<Text>)
           (install "count" (unary Nat Nat))
           (install "and" (binary Nat Nat Nat))
           (install "or" (binary Nat Nat Nat))
@@ -136,7 +136,7 @@
 (def: nat-procs
   Bundle
   (<| (prefix "nat")
-      (|> (d;new text;Hash<Text>)
+      (|> (dict;new text;Hash<Text>)
           (install "+" (binary Nat Nat Nat))
           (install "-" (binary Nat Nat Nat))
           (install "*" (binary Nat Nat Nat))
@@ -152,7 +152,7 @@
 (def: int-procs
   Bundle
   (<| (prefix "int")
-      (|> (d;new text;Hash<Text>)
+      (|> (dict;new text;Hash<Text>)
           (install "+" (binary Int Int Int))
           (install "-" (binary Int Int Int))
           (install "*" (binary Int Int Int))
@@ -168,7 +168,7 @@
 (def: deg-procs
   Bundle
   (<| (prefix "deg")
-      (|> (d;new text;Hash<Text>)
+      (|> (dict;new text;Hash<Text>)
           (install "+" (binary Deg Deg Deg))
           (install "-" (binary Deg Deg Deg))
           (install "*" (binary Deg Deg Deg))
@@ -185,7 +185,7 @@
 (def: frac-procs
   Bundle
   (<| (prefix "frac")
-      (|> (d;new text;Hash<Text>)
+      (|> (dict;new text;Hash<Text>)
           (install "+" (binary Frac Frac Frac))
           (install "-" (binary Frac Frac Frac))
           (install "*" (binary Frac Frac Frac))
@@ -207,7 +207,7 @@
 (def: text-procs
   Bundle
   (<| (prefix "text")
-      (|> (d;new text;Hash<Text>)
+      (|> (dict;new text;Hash<Text>)
           (install "=" (binary Text Text Bool))
           (install "<" (binary Text Text Bool))
           (install "prepend" (binary Text Text Text))
@@ -246,7 +246,7 @@
 (def: array-procs
   Bundle
   (<| (prefix "array")
-      (|> (d;new text;Hash<Text>)
+      (|> (dict;new text;Hash<Text>)
           (install "new" (unary Nat Array))
           (install "get" array-get)
           (install "put" array-put)
@@ -257,7 +257,7 @@
 (def: math-procs
   Bundle
   (<| (prefix "math")
-      (|> (d;new text;Hash<Text>)
+      (|> (dict;new text;Hash<Text>)
           (install "cos" (unary Frac Frac))
           (install "sin" (unary Frac Frac))
           (install "tan" (unary Frac Frac))
@@ -288,11 +288,11 @@
           (do Monad<Lux>
             [initA (&;with-expected-type varT
                      (analyse initC))
-             outputT (&;within-type-env
-                      (TC;clean var-id (type (A;Atom varT))))
+             outputT (&;with-type-env
+                       (tc;clean var-id (type (A;Atom varT))))
              expected macro;expected-type
-             _ (&;within-type-env
-                (TC;check expected outputT))]
+             _ (&;with-type-env
+                 (tc;check expected outputT))]
             (wrap (#la;Procedure proc (list initA))))
           
           _
@@ -317,7 +317,7 @@
 (def: atom-procs
   Bundle
   (<| (prefix "atom")
-      (|> (d;new text;Hash<Text>)
+      (|> (dict;new text;Hash<Text>)
           (install "new" atom-new)
           (install "read" atom-read)
           (install "compare-and-swap" atom-compare-and-swap)
@@ -326,7 +326,7 @@
 (def: process-procs
   Bundle
   (<| (prefix "process")
-      (|> (d;new text;Hash<Text>)
+      (|> (dict;new text;Hash<Text>)
           (install "concurrency-level" (nullary Nat))
           (install "future" (unary (type (io;IO Top)) Unit))
           (install "schedule" (binary Nat (type (io;IO Top)) Unit))
@@ -335,16 +335,16 @@
 (def: #export procedures
   Bundle
   (<| (prefix "lux")
-      (|> (d;new text;Hash<Text>)
-          (d;merge lux-procs)
-          (d;merge bit-procs)
-          (d;merge nat-procs)
-          (d;merge int-procs)
-          (d;merge deg-procs)
-          (d;merge frac-procs)
-          (d;merge text-procs)
-          (d;merge array-procs)
-          (d;merge math-procs)
-          (d;merge atom-procs)
-          (d;merge process-procs)
-          (d;merge io-procs))))
+      (|> (dict;new text;Hash<Text>)
+          (dict;merge lux-procs)
+          (dict;merge bit-procs)
+          (dict;merge nat-procs)
+          (dict;merge int-procs)
+          (dict;merge deg-procs)
+          (dict;merge frac-procs)
+          (dict;merge text-procs)
+          (dict;merge array-procs)
+          (dict;merge math-procs)
+          (dict;merge atom-procs)
+          (dict;merge process-procs)
+          (dict;merge io-procs))))
diff --git a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
index a8af2748a..1dba7a5f8 100644
--- a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
@@ -5,6 +5,7 @@
                 ["ex" exception #+ exception:])
        (concurrency ["A" atom])
        (data ["R" result]
+             [maybe]
              [product]
              [text "text/" Eq<Text>]
              (text format
@@ -18,7 +19,7 @@
        [host])
   (luxc ["&" base]
         ["&;" host]
-        (lang ["la" analysis #+ Analysis])
+        (lang ["la" analysis])
         (analyser ["&;" common]))
   ["@" ../common]
   )
@@ -245,7 +246,7 @@
     (case elemT
       (#;Host name #;Nil)
       (let [boxed-name (|> (dict;get name boxes)
-                           (default name))]
+                           (maybe;default name))]
         (wrap [(#;Host boxed-name #;Nil)
                boxed-name]))
 
@@ -267,8 +268,8 @@
           (do macro;Monad<Lux>
             [arrayA (&;with-expected-type (type (Array varT))
                       (analyse arrayC))
-             elemT (&;within-type-env
-                    (tc;read-var var-id))
+             elemT (&;with-type-env
+                     (tc;read var-id))
              [elemT elem-class] (box-array-element-type elemT)
              idxA (&;with-expected-type Nat
                     (analyse idxC))
@@ -288,8 +289,8 @@
           (do macro;Monad<Lux>
             [arrayA (&;with-expected-type (type (Array varT))
                       (analyse arrayC))
-             elemT (&;within-type-env
-                    (tc;read-var var-id))
+             elemT (&;with-type-env
+                     (tc;read var-id))
              [valueT elem-class] (box-array-element-type elemT)
              idxA (&;with-expected-type Nat
                     (analyse idxC))
@@ -334,8 +335,8 @@
           (do macro;Monad<Lux>
             [objectA (&;with-expected-type varT
                        (analyse objectC))
-             objectT (&;within-type-env
-                      (tc;read-var var-id))
+             objectT (&;with-type-env
+                       (tc;read var-id))
              _ (check-object objectT)
              _ (&;infer Bool)]
             (wrap (#la;Procedure proc (list objectA))))
@@ -353,8 +354,8 @@
           (do macro;Monad<Lux>
             [monitorA (&;with-expected-type varT
                         (analyse monitorC))
-             monitorT (&;within-type-env
-                       (tc;read-var var-id))
+             monitorT (&;with-type-env
+                        (tc;read var-id))
              _ (check-object monitorT)
              exprA (analyse exprC)]
             (wrap (#la;Procedure proc (list monitorA exprA))))
@@ -432,8 +433,8 @@
           (do macro;Monad<Lux>
             [exceptionA (&;with-expected-type varT
                           (analyse exceptionC))
-             exceptionT (&;within-type-env
-                         (tc;read-var var-id))
+             exceptionT (&;with-type-env
+                          (tc;read var-id))
              exception-class (check-object exceptionT)
              ? (sub-class? "java.lang.Throwable" exception-class)
              _ (: (Lux Unit)
@@ -478,8 +479,8 @@
             (do macro;Monad<Lux>
               [objectA (&;with-expected-type varT
                          (analyse objectC))
-               objectT (&;within-type-env
-                        (tc;read-var var-id))
+               objectT (&;with-type-env
+                         (tc;read var-id))
                object-class (check-object objectT)
                ? (sub-class? class object-class)]
               (if ?
@@ -599,13 +600,13 @@
     [to-name (check-jvm to)
      from-name (check-jvm from)]
     (cond (dict;contains? to-name boxes)
-          (let [box (assume (dict;get to-name boxes))]
+          (let [box (maybe;assume (dict;get to-name boxes))]
             (if (text/= box from-name)
               (wrap [box (#;Host to-name (list))])
               (&;throw Cannot-Cast-To-Primitive (format from-name " => " to-name))))
 
           (dict;contains? from-name boxes)
-          (let [box (assume (dict;get from-name boxes))]
+          (let [box (maybe;assume (dict;get from-name boxes))]
             (do @
               [[_ castT] (cast to (#;Host box (list)))]
               (wrap [from-name castT])))
@@ -709,8 +710,8 @@
                                             target-class))
          sourceA (&;with-expected-type varT
                    (analyse sourceC))
-         sourceT (&;within-type-env
-                  (tc;read-var var-id))
+         sourceT (&;with-type-env
+                   (tc;read var-id))
          [unboxed castT] (cast targetT sourceT)
          _ (&;assert (format "Object cannot be a primitive: " unboxed)
                      (text;empty? unboxed))]
@@ -722,8 +723,8 @@
       (do macro;Monad<Lux>
         [sourceA (&;with-expected-type varT
                    (analyse sourceC))
-         sourceT (&;within-type-env
-                  (tc;read-var var-id))
+         sourceT (&;with-type-env
+                   (tc;read var-id))
          [unboxed castT] (cast targetT sourceT)]
         (wrap [castT unboxed sourceA]))))
 
@@ -738,8 +739,8 @@
           [[fieldT final?] (static-field class field)
            expectedT macro;expected-type
            [unboxed castT] (cast expectedT fieldT)
-           _ (&;within-type-env
-              (tc;check expectedT castT))]
+           _ (&;with-type-env
+               (tc;check expectedT castT))]
           (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed)))))
 
         _
@@ -760,8 +761,8 @@
            _ (&;assert (Final-Field (format class "#" field))
                        (not final?))
            [valueT unboxed valueA] (analyse-input analyse fieldT valueC)
-           _ (&;within-type-env
-              (tc;check fieldT valueT))
+           _ (&;with-type-env
+               (tc;check fieldT valueT))
            _ (&;infer Unit)]
           (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) valueA))))
 
@@ -783,8 +784,8 @@
            [fieldT final?] (virtual-field class field objectT)
            expectedT macro;expected-type
            [unboxed castT] (cast expectedT fieldT)
-           _ (&;within-type-env
-              (tc;check expectedT castT))]
+           _ (&;with-type-env
+               (tc;check expectedT castT))]
           (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) objectA))))
 
         _
@@ -806,8 +807,8 @@
            _ (&;assert (Final-Field (format class "#" field))
                        (not final?))
            [valueT unboxed valueA] (analyse-input analyse fieldT valueC)
-           _ (&;within-type-env
-              (tc;check fieldT valueT))
+           _ (&;with-type-env
+               (tc;check fieldT valueT))
            _ (&;infer Unit)]
           (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) valueA objectA))))