- Updated new compiler's code to the recent changes in the language.

- WIP: Some other changes/additions to the new compiler.

7 files changed, 101 insertions, 101 deletions

diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux
index 6f9eda064..a7e420eec 100644
--- a/new-luxc/source/luxc/analyser.lux
+++ b/new-luxc/source/luxc/analyser.lux
@@ -52,7 +52,7 @@
               [#;Nat  &&primitive;analyse-nat]
               [#;Int  &&primitive;analyse-int]
               [#;Deg  &&primitive;analyse-deg]
-              [#;Real &&primitive;analyse-real]
+              [#;Frac &&primitive;analyse-frac]
               [#;Text &&primitive;analyse-text])
 
              (^ (#;Tuple (list)))
diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux
index 30d0a2b7a..0f5b4da4e 100644
--- a/new-luxc/source/luxc/analyser/case.lux
+++ b/new-luxc/source/luxc/analyser/case.lux
@@ -1,6 +1,6 @@
 (;module:
   lux
-  (lux (control monad
+  (lux (control [monad #+ do]
                 eq)
        (data [bool "B/" Eq<Bool>]
              [number]
@@ -102,7 +102,7 @@
      [Nat  #;Nat  #la;NatP]
      [Int  #;Int  #la;IntP]
      [Deg  #;Deg  #la;DegP]
-     [Real #;Real #la;RealP]
+     [Frac #;Frac #la;FracP]
      [Text #;Text #la;TextP])
 
     (^ [cursor (#;Tuple (list))])
@@ -225,14 +225,14 @@
       [[inputT inputA] (&common;with-unknown-type
                          (analyse input))
        outputH (analyse-pattern #;None inputT patternH (analyse bodyH))
-       outputT (mapM @
-                     (function [[patternT bodyT]]
-                       (analyse-pattern #;None inputT patternT (analyse bodyT)))
-                     branchesT)
-       _ (case (foldM R;Monad<Result>
-                      &&coverage;merge
-                      (|> outputH product;left &&coverage;determine)
-                      (L/map (|>. product;left &&coverage;determine) outputT))
+       outputT (monad;map @
+                          (function [[patternT bodyT]]
+                            (analyse-pattern #;None inputT patternT (analyse bodyT)))
+                          branchesT)
+       _ (case (monad;fold R;Monad<Result>
+                           &&coverage;merge
+                           (|> outputH product;left &&coverage;determine)
+                           (L/map (|>. product;left &&coverage;determine) outputT))
            (#R;Success coverage)
            (if (&&coverage;total? coverage)
              (wrap [])
diff --git a/new-luxc/source/luxc/analyser/case/coverage.lux b/new-luxc/source/luxc/analyser/case/coverage.lux
index 88e40ac0f..cb7341d7a 100644
--- a/new-luxc/source/luxc/analyser/case/coverage.lux
+++ b/new-luxc/source/luxc/analyser/case/coverage.lux
@@ -1,6 +1,6 @@
 (;module:
   lux
-  (lux (control monad
+  (lux (control [monad #+ do]
                 eq)
        (data [bool "B/" Eq<Bool>]
              [number]
@@ -54,7 +54,7 @@
     ## Primitive patterns always have partial coverage because there
     ## are too many possibilities as far as values go.
     (^or (#la;NatP _)  (#la;IntP _)  (#la;DegP _)
-         (#la;RealP _) (#la;TextP _))
+         (#la;FracP _) (#la;TextP _))
     #Partial
 
     ## Bools are the exception, since there is only "true" and
@@ -171,17 +171,17 @@
 
           ## else
           (do R;Monad<Result>
-            [casesM (foldM @
-                           (function [[tagA coverageA] casesSF']
-                             (case (D;get tagA casesSF')
-                               (#;Some coverageSF)
-                               (do @
-                                 [coverageM (merge coverageA coverageSF)]
-                                 (wrap (D;put tagA coverageM casesSF')))
-
-                               #;None
-                               (wrap (D;put tagA coverageA casesSF'))))
-                           casesSF (D;entries casesA))]
+            [casesM (monad;fold @
+                                (function [[tagA coverageA] casesSF']
+                                  (case (D;get tagA casesSF')
+                                    (#;Some coverageSF)
+                                    (do @
+                                      [coverageM (merge coverageA coverageSF)]
+                                      (wrap (D;put tagA coverageM casesSF')))
+
+                                    #;None
+                                    (wrap (D;put tagA coverageA casesSF'))))
+                                casesSF (D;entries casesA))]
             (wrap (if (let [case-coverages (D;values casesM)]
                         (and (n.= allSF (list;size case-coverages))
                              (list;every? total? case-coverages)))
diff --git a/new-luxc/source/luxc/analyser/primitive.lux b/new-luxc/source/luxc/analyser/primitive.lux
index 9102acda5..69e4f2b07 100644
--- a/new-luxc/source/luxc/analyser/primitive.lux
+++ b/new-luxc/source/luxc/analyser/primitive.lux
@@ -20,7 +20,7 @@
   [analyse-nat  Nat  #la;Nat]
   [analyse-int  Int  #la;Int]
   [analyse-deg  Deg  #la;Deg]
-  [analyse-real Real #la;Real]
+  [analyse-frac Frac #la;Frac]
   [analyse-text Text #la;Text]
   )
 
diff --git a/new-luxc/source/luxc/analyser/procedure.lux b/new-luxc/source/luxc/analyser/procedure.lux
index d8778844f..06ea7c324 100644
--- a/new-luxc/source/luxc/analyser/procedure.lux
+++ b/new-luxc/source/luxc/analyser/procedure.lux
@@ -1,10 +1,10 @@
 (;module:
   lux
-  (lux (control monad)
+  (lux (control [monad #+ do])
        (data [text]
              text/format
              (coll ["D" dict])
-             maybe))
+             [maybe]))
   (luxc ["&" base]
         (lang ["la" analysis #+ Analysis]))
   (. ["&&;" common]))
@@ -12,6 +12,6 @@
 (def: #export (analyse-procedure analyse proc-name proc-args)
   (-> &;Analyser Text (List Code) (Lux Analysis))
   (default (&;fail (format "Unknown procedure: " (%t proc-name)))
-    (do Monad<Maybe>
+    (do maybe;Monad<Maybe>
       [proc (D;get proc-name &&common;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 1976d266d..0ba35a82e 100644
--- a/new-luxc/source/luxc/analyser/procedure/common.lux
+++ b/new-luxc/source/luxc/analyser/procedure/common.lux
@@ -1,6 +1,6 @@
 (;module:
   lux
-  (lux (control monad)
+  (lux (control [monad #+ do])
        (concurrency ["A" atom])
        (data [text]
              text/format
@@ -39,11 +39,11 @@
       (let [num-actual (list;size args)]
         (if (n.= num-expected num-actual)
           (do Monad<Lux>
-            [argsA (mapM @
-                         (function [[argT argC]]
-                           (&;with-expected-type argT
-                             (analyse argC)))
-                         (list;zip2 input-types args))
+            [argsA (monad;map @
+                              (function [[argT argC]]
+                                (&;with-expected-type argT
+                                  (analyse argC)))
+                              (list;zip2 input-types args))
              expected macro;expected-type
              _ (&;within-type-env
                 (TC;check expected output-type))]
@@ -156,7 +156,7 @@
       (install "int min" (special-value Int))
       (install "int max" (special-value Int))
       (install "int to-nat" (converter Int Nat))
-      (install "int to-real" (converter Int Real))))
+      (install "int to-frac" (converter Int Frac))))
 
 (def: deg-procs
   Bundle
@@ -172,28 +172,28 @@
       (install "deg reciprocal" (binary-operation Deg Nat Deg))
       (install "deg min" (special-value Deg))
       (install "deg max" (special-value Deg))
-      (install "deg to-real" (converter Deg Real))))
+      (install "deg to-frac" (converter Deg Frac))))
 
-(def: real-procs
+(def: frac-procs
   Bundle
   (|> (D;new text;Hash<Text>)
-      (install "real +" (binary-operation Real Real Real))
-      (install "real -" (binary-operation Real Real Real))
-      (install "real *" (binary-operation Real Real Real))
-      (install "real /" (binary-operation Real Real Real))
-      (install "real %" (binary-operation Real Real Real))
-      (install "real =" (binary-operation Real Real Bool))
-      (install "real <" (binary-operation Real Real Bool))
-      (install "real smallest" (special-value Real))
-      (install "real min" (special-value Real))
-      (install "real max" (special-value Real))
-      (install "real not-a-number" (special-value Real))
-      (install "real positive-infinity" (special-value Real))
-      (install "real negative-infinity" (special-value Real))
-      (install "real to-deg" (converter Real Deg))
-      (install "real to-int" (converter Real Int))
-      (install "real to-text" (converter Real Text))
-      (install "real from-text" (converter Text (type (Maybe Real))))))
+      (install "frac +" (binary-operation Frac Frac Frac))
+      (install "frac -" (binary-operation Frac Frac Frac))
+      (install "frac *" (binary-operation Frac Frac Frac))
+      (install "frac /" (binary-operation Frac Frac Frac))
+      (install "frac %" (binary-operation Frac Frac Frac))
+      (install "frac =" (binary-operation Frac Frac Bool))
+      (install "frac <" (binary-operation Frac Frac Bool))
+      (install "frac smallest" (special-value Frac))
+      (install "frac min" (special-value Frac))
+      (install "frac max" (special-value Frac))
+      (install "frac not-a-number" (special-value Frac))
+      (install "frac positive-infinity" (special-value Frac))
+      (install "frac negative-infinity" (special-value Frac))
+      (install "frac to-deg" (converter Frac Deg))
+      (install "frac to-int" (converter Frac Int))
+      (install "frac encode" (converter Frac Text))
+      (install "frac decode" (converter Text (type (Maybe Frac))))))
 
 (def: text-procs
   Bundle
@@ -246,24 +246,24 @@
 (def: math-procs
   Bundle
   (|> (D;new text;Hash<Text>)
-      (install "math cos" (unary-operation Real Real))
-      (install "math sin" (unary-operation Real Real))
-      (install "math tan" (unary-operation Real Real))
-      (install "math acos" (unary-operation Real Real))
-      (install "math asin" (unary-operation Real Real))
-      (install "math atan" (unary-operation Real Real))
-      (install "math cosh" (unary-operation Real Real))
-      (install "math sinh" (unary-operation Real Real))
-      (install "math tanh" (unary-operation Real Real))
-      (install "math exp" (unary-operation Real Real))
-      (install "math log" (unary-operation Real Real))
-      (install "math root2" (unary-operation Real Real))
-      (install "math root3" (unary-operation Real Real))
-      (install "math ceil" (unary-operation Real Real))
-      (install "math floor" (unary-operation Real Real))
-      (install "math round" (unary-operation Real Real))
-      (install "math atan2" (binary-operation Real Real Real))
-      (install "math pow" (binary-operation Real Real Real))
+      (install "math cos" (unary-operation Frac Frac))
+      (install "math sin" (unary-operation Frac Frac))
+      (install "math tan" (unary-operation Frac Frac))
+      (install "math acos" (unary-operation Frac Frac))
+      (install "math asin" (unary-operation Frac Frac))
+      (install "math atan" (unary-operation Frac Frac))
+      (install "math cosh" (unary-operation Frac Frac))
+      (install "math sinh" (unary-operation Frac Frac))
+      (install "math tanh" (unary-operation Frac Frac))
+      (install "math exp" (unary-operation Frac Frac))
+      (install "math log" (unary-operation Frac Frac))
+      (install "math root2" (unary-operation Frac Frac))
+      (install "math root3" (unary-operation Frac Frac))
+      (install "math ceil" (unary-operation Frac Frac))
+      (install "math floor" (unary-operation Frac Frac))
+      (install "math round" (unary-operation Frac Frac))
+      (install "math atan2" (binary-operation Frac Frac Frac))
+      (install "math pow" (binary-operation Frac Frac Frac))
       ))
 
 (def: (analyse-atom-new proc)
@@ -326,7 +326,7 @@
       (D;merge nat-procs)
       (D;merge int-procs)
       (D;merge deg-procs)
-      (D;merge real-procs)
+      (D;merge frac-procs)
       (D;merge text-procs)
       (D;merge array-procs)
       (D;merge math-procs)
diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux
index 267dfec84..ad7ad2a7a 100644
--- a/new-luxc/source/luxc/analyser/structure.lux
+++ b/new-luxc/source/luxc/analyser/structure.lux
@@ -1,6 +1,6 @@
 (;module:
   lux
-  (lux (control monad
+  (lux (control [monad #+ do]
                 pipe)
        [io #- run]
        [function]
@@ -154,8 +154,8 @@
                 (analyse-product analyse membersC)))
             ## Must do inference...
             (do @
-              [membersTA (mapM @ (|>. analyse &common;with-unknown-type)
-                               membersC)
+              [membersTA (monad;map @ (|>. analyse &common;with-unknown-type)
+                                    membersC)
                _ (&;within-type-env
                   (TC;check expected
                             (type;tuple (L/map product;left membersTA))))]
@@ -198,17 +198,17 @@
 ## canonical form (with their corresponding module identified).
 (def: #export (normalize record)
   (-> (List [Code Code]) (Lux (List [Ident Code])))
-  (mapM Monad<Lux>
-        (function [[key val]]
-          (case key
-            [_ (#;Tag key)]
-            (do Monad<Lux>
-              [key (macro;normalize key)]
-              (wrap [key val]))
+  (monad;map Monad<Lux>
+             (function [[key val]]
+               (case key
+                 [_ (#;Tag key)]
+                 (do Monad<Lux>
+                   [key (macro;normalize key)]
+                   (wrap [key val]))
 
-            _
-            (&;fail (format "Cannot use non-tag tokens in key positions in records: " (%code key)))))
-        record))
+                 _
+                 (&;fail (format "Cannot use non-tag tokens in key positions in records: " (%code key)))))
+             record))
 
 ## Lux already possesses the means to analyse tuples, so
 ## re-implementing the same functionality for records makes no sense.
@@ -234,22 +234,22 @@
                            "For type: " (%type recordT))))
        #let [tuple-range (list;n.range +0 (n.dec size-ts))
              tag->idx (D;from-list ident;Hash<Ident> (list;zip2 tag-set tuple-range))]
-       idx->val (foldM @
-                       (function [[key val] idx->val]
-                         (do @
-                           [key (macro;normalize key)]
-                           (case (D;get key tag->idx)
-                             #;None
-                             (&;fail (format "Tag " (%code (code;tag key))
-                                             " does not belong to tag-set for type " (%type recordT)))
+       idx->val (monad;fold @
+                            (function [[key val] idx->val]
+                              (do @
+                                [key (macro;normalize key)]
+                                (case (D;get key tag->idx)
+                                  #;None
+                                  (&;fail (format "Tag " (%code (code;tag key))
+                                                  " does not belong to tag-set for type " (%type recordT)))
 
-                             (#;Some idx)
-                             (if (D;contains? idx idx->val)
-                               (&;fail (format "Cannot repeat tag inside record: " (%code (code;tag key))))
-                               (wrap (D;put idx val idx->val))))))
-                       (: (D;Dict Nat Code)
-                          (D;new number;Hash<Nat>))
-                       record)
+                                  (#;Some idx)
+                                  (if (D;contains? idx idx->val)
+                                    (&;fail (format "Cannot repeat tag inside record: " (%code (code;tag key))))
+                                    (wrap (D;put idx val idx->val))))))
+                            (: (D;Dict Nat Code)
+                               (D;new number;Hash<Nat>))
+                            record)
        #let [ordered-tuple (L/map (function [idx] (assume (D;get idx idx->val)))
                                   tuple-range)]]
       (wrap [ordered-tuple recordT]))