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

1 files changed, 197 insertions, 0 deletions

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])))