- Improved debugging machinery.

- Now also displaying dynamic values with the help of "lux/debug.representation".

3 files changed, 167 insertions, 211 deletions

diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux
index 63a46aff4..43d3f4762 100644
--- a/stdlib/source/lux/debug.lux
+++ b/stdlib/source/lux/debug.lux
@@ -1,14 +1,31 @@
 (.module:
   [lux #*
+   ["." type]
+   ["." host (#+ import:)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." function]
+    ["." exception (#+ exception:)]
+    ["<>" parser
+     ["<.>" type (#+ Parser)]]
+    pipe]
    [data
+    ["." error (#+ Error)]
     ["." text
      format]
+    [format
+     [xml (#+ XML)]
+     [json (#+ JSON)]]
     [collection
      ["." array (#+ Array)]
      ["." list ("#@." functor)]]]
+   [time
+    [instant (#+ Instant)]
+    [duration (#+ Duration)]
+    [date (#+ Date)]]
    [macro
-    ["." template]]
-   ["." host (#+ import:)]])
+    ["." template]]])
 
 (import: #long java/lang/String)
 
@@ -73,3 +90,139 @@
               #.None)
             (java/lang/Object::toString object)))
     ))
+
+(exception: #export (cannot-represent-value {type Type})
+  (exception.report
+   ["Type" (%type type)]))
+
+(type: Representation (-> Any Text))
+
+(def: primitive-representation
+  (Parser Representation)
+  (`` ($_ <>.either
+          (do <>.monad
+            [_ (<type>.exactly Any)]
+            (wrap (function.constant "[]")))
+          
+          (~~ (template [<type> <formatter>]
+                [(do <>.monad
+                   [_ (<type>.sub <type>)]
+                   (wrap (|>> (:coerce <type>) <formatter>)))]
+
+                [Bit %b]
+                [Nat %n]
+                [Int %i]
+                [Rev %r]
+                [Frac %f]
+                [Text %t])))))
+
+(def: (special-representation representation)
+  (-> (Parser Representation) (Parser Representation))
+  (`` ($_ <>.either
+          (~~ (template [<type> <formatter>]
+                [(do <>.monad
+                   [_ (<type>.sub <type>)]
+                   (wrap (|>> (:coerce <type>) <formatter>)))]
+
+                [Type %type]
+                [Code %code]
+                [Instant %instant]
+                [Duration %duration]
+                [Date %date]
+                [JSON %json]
+                [XML %xml]))
+
+          (do <>.monad
+            [[_ elemT] (<type>.apply (<>.and (<type>.exactly List) <type>.any))
+             elemR (<type>.local (list elemT) representation)]
+            (wrap (|>> (:coerce (List Any)) (%list elemR))))
+
+          (do <>.monad
+            [[_ elemT] (<type>.apply (<>.and (<type>.exactly Maybe) <type>.any))
+             elemR (<type>.local (list elemT) representation)]
+            (wrap (|>> (:coerce (Maybe Any))
+                       (case> #.None
+                              "#.None"
+
+                              (#.Some elemV)
+                              (format "(#.Some " (elemR elemV) ")"))))))))
+
+(def: (variant-representation representation)
+  (-> (Parser Representation) (Parser Representation))
+  (do <>.monad
+    [membersR+ (<type>.variant (<>.many representation))]
+    (wrap (function (_ variantV)
+            (let [[lefts right? sub-repr] (loop [lefts 0
+                                                 representations membersR+
+                                                 variantV variantV]
+                                            (case representations
+                                              (#.Cons leftR (#.Cons rightR extraR+))
+                                              (case (:coerce (| Any Any) variantV)
+                                                (#.Left left)
+                                                [lefts #0 (leftR left)]
+
+                                                (#.Right right)
+                                                (case extraR+
+                                                  #.Nil
+                                                  [lefts #1 (rightR right)]
+
+                                                  extraR+
+                                                  (recur (inc lefts) (#.Cons rightR extraR+) right)))
+
+                                              _
+                                              (undefined)))]
+              (format "(" (%n lefts) " " (%b right?) " " sub-repr ")"))))))
+
+(def: (tuple-representation representation)
+  (-> (Parser Representation) (Parser Representation))
+  (do <>.monad
+    [membersR+ (<type>.tuple (<>.many representation))]
+    (wrap (function (_ tupleV)
+            (let [tuple-body (loop [representations membersR+
+                                    tupleV tupleV]
+                               (case representations
+                                 #.Nil
+                                 ""
+                                 
+                                 (#.Cons lastR #.Nil)
+                                 (lastR tupleV)
+                                 
+                                 (#.Cons headR tailR)
+                                 (let [[leftV rightV] (:coerce [Any Any] tupleV)]
+                                   (format (headR leftV) " " (recur tailR rightV)))))]
+              (format "[" tuple-body "]"))))))
+
+(def: representation
+  (Parser Representation)
+  (<>.rec
+   (function (_ representation)
+     ($_ <>.either
+         primitive-representation
+         (special-representation representation)
+         (variant-representation representation)
+         (tuple-representation representation)
+
+         (do <>.monad
+           [[funcT inputsT+] (<type>.apply (<>.and <type>.any (<>.many <type>.any)))]
+           (case (type.apply inputsT+ funcT)
+             (#.Some outputT)
+             (<type>.local (list outputT) representation)
+
+             #.None
+             (<>.fail "")))
+
+         (do <>.monad
+           [[name anonymous] <type>.named]
+           (<type>.local (list anonymous) representation))
+
+         (<>.fail "")
+         ))))
+
+(def: #export (represent type value)
+  (-> Type Any (Error Text))
+  (case (<type>.run type ..representation)
+    (#error.Success representation)
+    (#error.Success (representation value))
+
+    (#error.Failure error)
+    (exception.throw cannot-represent-value type)))
diff --git a/stdlib/source/lux/tool/interpreter/type.lux b/stdlib/source/lux/tool/interpreter/type.lux
deleted file mode 100644
index b9d4ebb5b..000000000
--- a/stdlib/source/lux/tool/interpreter/type.lux
+++ /dev/null
@@ -1,204 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    ["ex" exception (#+ exception:)]
-    ["p" parser
-     ["<.>" type (#+ Parser)]]
-    pipe]
-   [data
-    ["." error (#+ Error)]
-    [text
-     format]
-    [format
-     [xml (#+ XML)]
-     [json (#+ JSON)]]
-    [collection
-     ["." list]]]
-   [time
-    [instant (#+ Instant)]
-    [duration (#+ Duration)]
-    [date (#+ Date)]]
-   ["." function]
-   ["." type]
-   ["." macro
-    ["." code]
-    ["." poly]]])
-
-(exception: #export (cannot-represent-value {type Type})
-  (ex.report ["Type" (%type type)]))
-
-(type: Representation (-> Any Text))
-
-(def: primitive-representation
-  (Parser Representation)
-  (`` ($_ p.either
-          (do p.monad
-            [_ (poly.exactly Any)]
-            (wrap (function.constant "[]")))
-          
-          (~~ (template [<type> <formatter>]
-                [(do p.monad
-                   [_ (poly.sub <type>)]
-                   (wrap (|>> (:coerce <type>) <formatter>)))]
-
-                [Bit %b]
-                [Nat %n]
-                [Int %i]
-                [Rev %r]
-                [Frac %f]
-                [Text %t])))))
-
-(def: (special-representation representation)
-  (-> (Parser Representation) (Parser Representation))
-  (`` ($_ p.either
-          (~~ (template [<type> <formatter>]
-                [(do p.monad
-                   [_ (poly.sub <type>)]
-                   (wrap (|>> (:coerce <type>) <formatter>)))]
-
-                [Type %type]
-                [Code %code]
-                [Instant %instant]
-                [Duration %duration]
-                [Date %date]
-                [JSON %json]
-                [XML %xml]))
-
-          (do p.monad
-            [[_ elemT] (poly.apply (p.and (poly.exactly List) poly.any))
-             elemR (poly.local (list elemT) representation)]
-            (wrap (|>> (:coerce (List Any)) (%list elemR))))
-
-          (do p.monad
-            [[_ elemT] (poly.apply (p.and (poly.exactly Maybe) poly.any))
-             elemR (poly.local (list elemT) representation)]
-            (wrap (|>> (:coerce (Maybe Any))
-                       (case> #.None
-                              "#.None"
-
-                              (#.Some elemV)
-                              (format "(#.Some " (elemR elemV) ")"))))))))
-
-(def: (record-representation tags representation)
-  (-> (List Name) (Parser Representation) (Parser Representation))
-  (do p.monad
-    [membersR+ (poly.tuple (p.many representation))
-     _ (p.assert "Number of tags does not match record type size."
-                 (n/= (list.size tags) (list.size membersR+)))]
-    (wrap (function (_ recordV)
-            (let [record-body (loop [pairs-left (list.zip2 tags membersR+)
-                                     recordV recordV]
-                                (case pairs-left
-                                  #.Nil
-                                  ""
-
-                                  (#.Cons [tag repr] #.Nil)
-                                  (format (%code (code.tag tag)) " " (repr recordV))
-
-                                  (#.Cons [tag repr] tail)
-                                  (let [[leftV rightV] (:coerce [Any Any] recordV)]
-                                    (format (%code (code.tag tag)) " " (repr leftV) " "
-                                            (recur tail rightV)))))]
-              (format "{" record-body "}"))))))
-
-(def: (variant-representation tags representation)
-  (-> (List Name) (Parser Representation) (Parser Representation))
-  (do p.monad
-    [casesR+ (poly.variant (p.many representation))
-     #let [num-tags (list.size tags)]
-     _ (p.assert "Number of tags does not match variant type size."
-                 (n/= num-tags (list.size casesR+)))]
-    (wrap (function (_ variantV)
-            (loop [cases-left (list.zip3 tags
-                                         (list.indices num-tags)
-                                         casesR+)
-                   variantV variantV]
-              (case cases-left
-                #.Nil
-                ""
-
-                (#.Cons [tag-name tag-idx repr] #.Nil)
-                (let [[_tag _last? _value] (:coerce [Nat Text Any] variantV)]
-                  (if (n/= tag-idx _tag)
-                    (format "(" (%code (code.tag tag-name)) " " (repr _value) ")")
-                    (undefined)))
-
-                (#.Cons [tag-name tag-idx repr] tail)
-                (let [[_tag _last? _value] (:coerce [Nat Text Any] variantV)]
-                  (if (n/= tag-idx _tag)
-                    (format "(" (%code (code.tag tag-name)) " " (repr _value) ")")
-                    (recur tail variantV)))))))))
-
-(def: (tagged-representation compiler representation)
-  (-> Lux (Parser Representation) (Parser Representation))
-  (do p.monad
-    [[name anonymous] poly.named]
-    (case (macro.run compiler (macro.tags-of name))
-      (#error.Success ?tags)
-      (case ?tags
-        (#.Some tags)
-        (poly.local (list anonymous)
-                    (p.either (record-representation tags representation)
-                              (variant-representation tags representation)))
-        
-        #.None
-        representation)
-      
-      (#error.Failure error)
-      (p.fail error))))
-
-(def: (tuple-representation representation)
-  (-> (Parser Representation) (Parser Representation))
-  (do p.monad
-    [membersR+ (poly.tuple (p.many representation))]
-    (wrap (function (_ tupleV)
-            (let [tuple-body (loop [representations membersR+
-                                    tupleV tupleV]
-                               (case representations
-                                 #.Nil
-                                 ""
-                                 
-                                 (#.Cons lastR #.Nil)
-                                 (lastR tupleV)
-                                 
-                                 (#.Cons headR tailR)
-                                 (let [[leftV rightV] (:coerce [Any Any] tupleV)]
-                                   (format (headR leftV) " " (recur tailR rightV)))))]
-              (format "[" tuple-body "]"))))))
-
-(def: (representation compiler)
-  (-> Lux (Parser Representation))
-  (p.rec
-   (function (_ representation)
-     ($_ p.either
-         primitive-representation
-         (special-representation representation)
-         (tagged-representation compiler representation)
-         (tuple-representation representation)
-
-         (do p.monad
-           [[funcT inputsT+] (poly.apply (p.and poly.any (p.many poly.any)))]
-           (case (type.apply inputsT+ funcT)
-             (#.Some outputT)
-             (poly.local (list outputT) representation)
-
-             #.None
-             (p.fail "")))
-
-         (do p.monad
-           [[name anonymous] poly.named]
-           (poly.local (list anonymous) representation))
-
-         (p.fail "")
-         ))))
-
-(def: #export (represent compiler type value)
-  (-> Lux Type Any Text)
-  (case (poly.run type (representation compiler))
-    (#error.Success representation)
-    (ex.report ["Type" (%type type)]
-               ["Value" (representation value)])
-
-    (#error.Failure error)
-    (ex.construct cannot-represent-value [type])))
diff --git a/stdlib/source/lux/type/dynamic.lux b/stdlib/source/lux/type/dynamic.lux
index cda9ac14b..aaa5ae6e7 100644
--- a/stdlib/source/lux/type/dynamic.lux
+++ b/stdlib/source/lux/type/dynamic.lux
@@ -1,9 +1,10 @@
 (.module:
   [lux #*
+   ["." debug]
    [control
-    ["ex" exception (#+ exception:)]]
+    ["." exception (#+ exception:)]]
    [data
-    ["." error]
+    ["." error (#+ Error)]
     [text
      format]]
    [macro (#+ with-gensyms)
@@ -12,8 +13,9 @@
     abstract]])
 
 (exception: #export (wrong-type {expected Type} {actual Type})
-  (ex.report ["Expected" (%type expected)]
-             ["Actual" (%type actual)]))
+  (exception.report
+   ["Expected" (%type expected)]
+   ["Actual" (%type actual)]))
 
 (abstract: #export Dynamic
   {#.doc "A value coupled with its type, so it can be checked later."}
@@ -39,5 +41,10 @@
                           (if (:: (~! type.equivalence) (~' =)
                                   (.type (~ type)) (~ g!type))
                             (#error.Success (:coerce (~ type) (~ g!value)))
-                            ((~! ex.throw) ..wrong-type [(.type (~ type)) (~ g!type)])))))))))
+                            ((~! exception.throw) ..wrong-type [(.type (~ type)) (~ g!type)])))))))))
+
+  (def: #export (print value)
+    (-> Dynamic (Error Text))
+    (let [[type value] (:representation value)]
+      (debug.represent type value)))
   )