- Moved the type-based value representation of the REPL into the standard library.

2 files changed, 201 insertions, 199 deletions

diff --git a/new-luxc/source/luxc/repl.lux b/new-luxc/source/luxc/repl.lux
index 2fb62a3b4..9df2d181d 100644
--- a/new-luxc/source/luxc/repl.lux
+++ b/new-luxc/source/luxc/repl.lux
@@ -1,27 +1,14 @@
 (.module:
   lux
   (lux (control [monad #+ do]
-                ["ex" exception #+ exception:]
-                ["p" parser]
-                pipe)
+                ["ex" exception #+ exception:])
        (data [maybe]
              ["e" error #+ Error]
-             [text "text/" Eq<Text>]
+             [text "text/" Equivalence<Text>]
              text/format
-             (format [xml #+ XML]
-                     [json #+ JSON])
-             (coll [array]
-                   [list "list/" Functor<List>]
-                   (dictionary ["dict" unordered])))
-       (time [instant #+ Instant]
-             [duration #+ Duration]
-             [date #+ Date])
-       [function #+ const]
+             (coll (dictionary ["dict" unordered])))
        [macro]
-       (macro [code]
-              [poly #+ Poly])
        (lang [syntax #+ Aliases]
-             [type]
              (type [check])
              [".L" init]
              [".L" module]
@@ -91,186 +78,6 @@
   (-> Text Source Source)
   [where offset (format input "\n" line)])
 
-(type: Representation (-> Any Text))
-
-(def: (represent-together representations values)
-  (-> (List Representation) (List Any) (List Text))
-  (|> (list.zip2 representations values)
-      (list/map (function (_ [representation value]) (representation value)))))
-
-(def: primitive-representation
-  (Poly Representation)
-  (`` ($_ p.either
-          (do p.Monad<Parser>
-            [_ (poly.this Any)]
-            (wrap (const "[]")))
-          
-          (~~ (do-template [<type> <formatter>]
-                [(do p.Monad<Parser>
-                   [_ (poly.like <type>)]
-                   (wrap (|>> (:coerce <type>) <formatter>)))]
-
-                [Bool %b]
-                [Nat %n]
-                [Int %i]
-                [Rev %r]
-                [Frac %f]
-                [Text %t])))))
-
-(def: (special-representation representation)
-  (-> (Poly Representation) (Poly Representation))
-  (`` ($_ p.either
-          (~~ (do-template [<type> <formatter>]
-                [(do p.Monad<Parser>
-                   [_ (poly.like <type>)]
-                   (wrap (|>> (:coerce <type>) <formatter>)))]
-
-                [Type %type]
-                [Code %code]
-                [Instant %instant]
-                [Duration %duration]
-                [Date %date]
-                [JSON %json]
-                [XML %xml]
-                ))
-
-          (do p.Monad<Parser>
-            [[_ elemT] (poly.apply (p.seq (poly.this List) poly.any))
-             elemR (poly.local (list elemT) representation)]
-            (wrap (|>> (:coerce (List Any)) (%list elemR))))
-
-          (do p.Monad<Parser>
-            [[_ elemT] (poly.apply (p.seq (poly.this 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 Ident) (Poly Representation) (Poly Representation))
-  (do p.Monad<Parser>
-    [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 Ident) (Poly Representation) (Poly Representation))
-  (do p.Monad<Parser>
-    [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.n/range +0 (dec 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 (Poly Representation) (Poly Representation))
-  (do p.Monad<Parser>
-    [[name anonymous] poly.named]
-    (case (macro.run compiler (macro.tags-of name))
-      (#e.Success ?tags)
-      (case ?tags
-        (#.Some tags)
-        (poly.local (list anonymous)
-                    (p.either (record-representation tags representation)
-                              (variant-representation tags representation)))
-        
-        #.None
-        representation)
-      
-      (#e.Error error)
-      (p.fail error))))
-
-(def: (tuple-representation representation)
-  (-> (Poly Representation) (Poly Representation))
-  (do p.Monad<Parser>
-    [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 (Poly Representation))
-  (p.rec
-   (function (_ representation)
-     ($_ p.either
-         primitive-representation
-         (special-representation representation)
-         (tagged-representation compiler representation)
-         (tuple-representation representation)
-
-         (do p.Monad<Parser>
-           [[funcT inputsT+] (poly.apply (p.seq poly.any (p.many poly.any)))]
-           (case (type.apply inputsT+ funcT)
-             (#.Some outputT)
-             (poly.local (list outputT) representation)
-
-             #.None
-             (p.fail "")))
-
-         (do p.Monad<Parser>
-           [[name anonymous] poly.named]
-           (poly.local (list anonymous) representation))
-
-         (p.fail "")
-         ))))
-
-(def: (represent compiler type value)
-  (-> Lux Type Any Text)
-  (case (poly.run type (representation compiler))
-    (#e.Success representation)
-    (representation value)
-
-    (#e.Error error)
-    ". . . cannot represent value . . ."))
-
 (def: (repl-translate source-dirs target-dir code)
   (-> (List File) File Code (Meta [Type Any]))
   (function (_ compiler)
@@ -318,9 +125,7 @@
                                   (wrap [source' exprT exprV])))))
             (#e.Success [compiler' [source' exprT exprV]])
             (do @
-              [_ (console.write (format " Type: " (type.to-text exprT) "\n"
-                                        "Value: " (represent compiler' exprT exprV) "\n\n")
-                                console)]
+              [_ (console.write (represent compiler' exprT exprV) console)]
               (recur compiler' source' false))
 
             (#e.Error error)
diff --git a/stdlib/source/lux/lang/compiler/default/repl/type.lux b/stdlib/source/lux/lang/compiler/default/repl/type.lux
new file mode 100644
index 000000000..2fc2c74b6
--- /dev/null
+++ b/stdlib/source/lux/lang/compiler/default/repl/type.lux
@@ -0,0 +1,197 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
+                ["p" parser]
+                pipe)
+       (data [error #+ Error]
+             text/format
+             (format [xml #+ XML]
+                     [json #+ JSON])
+             (coll [list]))
+       (time [instant #+ Instant]
+             [duration #+ Duration]
+             [date #+ Date])
+       [function]
+       [macro]
+       (macro [code]
+              [poly #+ Poly])
+       (lang [type])))
+
+(exception: #export (cannot-represent-value {type Type})
+  (ex.report ["Type" (%type type)]))
+
+(type: Representation (-> Any Text))
+
+(def: primitive-representation
+  (Poly Representation)
+  (`` ($_ p.either
+          (do p.Monad<Parser>
+            [_ (poly.this Any)]
+            (wrap (function.constant "[]")))
+          
+          (~~ (do-template [<type> <formatter>]
+                [(do p.Monad<Parser>
+                   [_ (poly.like <type>)]
+                   (wrap (|>> (:coerce <type>) <formatter>)))]
+
+                [Bool %b]
+                [Nat %n]
+                [Int %i]
+                [Rev %r]
+                [Frac %f]
+                [Text %t])))))
+
+(def: (special-representation representation)
+  (-> (Poly Representation) (Poly Representation))
+  (`` ($_ p.either
+          (~~ (do-template [<type> <formatter>]
+                [(do p.Monad<Parser>
+                   [_ (poly.like <type>)]
+                   (wrap (|>> (:coerce <type>) <formatter>)))]
+
+                [Type %type]
+                [Code %code]
+                [Instant %instant]
+                [Duration %duration]
+                [Date %date]
+                [JSON %json]
+                [XML %xml]))
+
+          (do p.Monad<Parser>
+            [[_ elemT] (poly.apply (p.seq (poly.this List) poly.any))
+             elemR (poly.local (list elemT) representation)]
+            (wrap (|>> (:coerce (List Any)) (%list elemR))))
+
+          (do p.Monad<Parser>
+            [[_ elemT] (poly.apply (p.seq (poly.this 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 Ident) (Poly Representation) (Poly Representation))
+  (do p.Monad<Parser>
+    [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 Ident) (Poly Representation) (Poly Representation))
+  (do p.Monad<Parser>
+    [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.n/range +0 (dec 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 (Poly Representation) (Poly Representation))
+  (do p.Monad<Parser>
+    [[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.Error error)
+      (p.fail error))))
+
+(def: (tuple-representation representation)
+  (-> (Poly Representation) (Poly Representation))
+  (do p.Monad<Parser>
+    [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 (Poly Representation))
+  (p.rec
+   (function (_ representation)
+     ($_ p.either
+         primitive-representation
+         (special-representation representation)
+         (tagged-representation compiler representation)
+         (tuple-representation representation)
+
+         (do p.Monad<Parser>
+           [[funcT inputsT+] (poly.apply (p.seq poly.any (p.many poly.any)))]
+           (case (type.apply inputsT+ funcT)
+             (#.Some outputT)
+             (poly.local (list outputT) representation)
+
+             #.None
+             (p.fail "")))
+
+         (do p.Monad<Parser>
+           [[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.Error error)
+    (ex.construct cannot-represent-value [type])))