From ff537895fe9c24f37a0ce11b640af5d4882571a5 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 29 Aug 2021 18:30:29 -0400
Subject: Better parameterized type documentation.

---
 stdlib/source/program/scriptum.lux | 224 ++++++++++++++++++-------------------
 1 file changed, 112 insertions(+), 112 deletions(-)

(limited to 'stdlib/source/program')

diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux
index 438b071ec..2b2d6e01b 100644
--- a/stdlib/source/program/scriptum.lux
+++ b/stdlib/source/program/scriptum.lux
@@ -90,120 +90,120 @@
 ...         (enum.range n.enum 0)
 ...         (list\each (|>> (n.+ (++ offset)) parameter_type_name)))))
 
-(def: (prefix_lines prefix lines)
-  (-> Text Text Text)
-  (|> lines
-      (text.all_split_by text.new_line)
-      (list\each (|>> (format prefix)))
-      (text.interposed text.new_line)))
-
-(def: (pprint_type_definition level type_function_info tags module interface? recursive_type? type)
-  (-> Nat [Text (List Text)] (List Name) Text Bit Bit Type Text)
-  (case tags
-    (^ (list [_ single_tag]))
-    (if interface?
-      (format "(: " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) text.new_line "   " single_tag ")")
-      (format "{#" single_tag " " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) "}"))
+... (def: (prefix_lines prefix lines)
+...   (-> Text Text Text)
+...   (|> lines
+...       (text.all_split_by text.new_line)
+...       (list\each (|>> (format prefix)))
+...       (text.interposed text.new_line)))
 
-    _
-    (case [recursive_type? type]
-      [_ (#.Primitive name params)]
-      (case params
-        #.End
-        (format "(primitive " (%.text name) ")")
-
-        _
-        (format "(primitive " (%.text name) " " (|> params (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) ")"))
-
-      [_ (#.Sum _)]
-      (let [members (type.flat_variant type)]
-        (case tags
-          #.End
-          (format "(Or "
-                  (|> members
-                      (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?))
-                      (text.interposed " "))
-                  ")")
-
-          _
-          (|> members
-              (list.zipped/2 tags)
-              (list\each (function (_ [[_ t_name] type])
-                           (case type
-                             (#.Product _)
-                             (let [types (type.flat_tuple type)]
-                               (format "(#" t_name " "
-                                       (|> types
-                                           (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?))
-                                           (text.interposed " "))
-                                       ")"))
-
-                             _
-                             (format "(#" t_name " " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) ")"))))
-              (text.interposed text.new_line))))
-
-      [_ (#.Product _)]
-      (let [members (type.flat_tuple type)]
-        (case tags
-          #.End
-          (format "[" (|> members (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) "]")
-
-          _
-          (let [member_docs (|> members
-                                (list.zipped/2 tags)
-                                (list\each (function (_ [[_ t_name] type])
-                                             (if interface?
-                                               (format "(: " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) text.new_line "   "  t_name ")")
-                                               (format "#" t_name " " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type)))))
-                                (text.interposed (format text.new_line " ")))]
-            (if interface?
-              member_docs
-              (format "{" member_docs "}")))))
-
-      [_ (#.Function input output)]
-      (let [[ins out] (type.flat_function type)]
-        (format  "(-> " (|> ins (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " "))
-                 " "
-                 (pprint_type_definition level type_function_info #.None module interface? recursive_type? out)
-                 ")"))
-
-      [_ (#.Parameter idx)]
-      (parameter_name type_function_info level idx)
-
-      (^template [<tag> <pre> <post>]
-        [[_ (<tag> id)]
-         (format <pre> (%.nat id) <post>)])
-      ([#.Var "⌈v:" "⌋"]
-       [#.Ex  "⟨e:" "⟩"])
-
-      (^template [<tag> <name> <flat>]
-        [[_ (<tag> _)]
-         (let [[level' body] (<flat> type)
-               args (level_parameters level level')
-               body_doc (pprint_type_definition (n.+ level level') type_function_info tags module interface? recursive_type? body)]
-           (format "(" <name> " " "[" (text.interposed " " args) "]"
-                   (case tags
-                     #.End
-                     (format " " body_doc)
+... (def: (pprint_type_definition level type_function_info tags module interface? recursive_type? type)
+...   (-> Nat [Text (List Text)] (List Name) Text Bit Bit Type Text)
+...   (case tags
+...     (^ (list [_ single_tag]))
+...     (if interface?
+...       (format "(: " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) text.new_line "   " single_tag ")")
+...       (format "{#" single_tag " " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) "}"))
+
+...     _
+...     (case [recursive_type? type]
+...       [_ (#.Primitive name params)]
+...       (case params
+...         #.End
+...         (format "(primitive " (%.text name) ")")
 
-                     _
-                     (format text.new_line (prefix_lines "  " body_doc)))
-                   ")"))])
-      ([#.UnivQ "All" type.flat_univ_q]
-       [#.ExQ   "Ex"  type.flat_ex_q])
-
-      [true (#.Apply (#.Parameter 1) (#.Parameter 0))]
-      (product.left type_function_info)
-
-      [_ (#.Apply param fun)]
-      (let [[type_func type_arguments] (type.flat_application type)]
-        (format  "(" (pprint_type_definition level type_function_info tags module interface? recursive_type? type_func) " " (|> type_arguments (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) ")"))
-
-      [_ (#.Named [_module _name] type)]
-      (if (text\= module _module)
-        _name
-        (%.name [_module _name]))
-      )))
+...         _
+...         (format "(primitive " (%.text name) " " (|> params (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) ")"))
+
+...       [_ (#.Sum _)]
+...       (let [members (type.flat_variant type)]
+...         (case tags
+...           #.End
+...           (format "(Or "
+...                   (|> members
+...                       (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?))
+...                       (text.interposed " "))
+...                   ")")
+
+...           _
+...           (|> members
+...               (list.zipped/2 tags)
+...               (list\each (function (_ [[_ t_name] type])
+...                            (case type
+...                              (#.Product _)
+...                              (let [types (type.flat_tuple type)]
+...                                (format "(#" t_name " "
+...                                        (|> types
+...                                            (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?))
+...                                            (text.interposed " "))
+...                                        ")"))
+
+...                              _
+...                              (format "(#" t_name " " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) ")"))))
+...               (text.interposed text.new_line))))
+
+...       [_ (#.Product _)]
+...       (let [members (type.flat_tuple type)]
+...         (case tags
+...           #.End
+...           (format "[" (|> members (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) "]")
+
+...           _
+...           (let [member_docs (|> members
+...                                 (list.zipped/2 tags)
+...                                 (list\each (function (_ [[_ t_name] type])
+...                                              (if interface?
+...                                                (format "(: " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) text.new_line "   "  t_name ")")
+...                                                (format "#" t_name " " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type)))))
+...                                 (text.interposed (format text.new_line " ")))]
+...             (if interface?
+...               member_docs
+...               (format "{" member_docs "}")))))
+
+...       [_ (#.Function input output)]
+...       (let [[ins out] (type.flat_function type)]
+...         (format  "(-> " (|> ins (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " "))
+...                  " "
+...                  (pprint_type_definition level type_function_info #.None module interface? recursive_type? out)
+...                  ")"))
+
+...       [_ (#.Parameter idx)]
+...       (parameter_name type_function_info level idx)
+
+...       (^template [<tag> <pre> <post>]
+...         [[_ (<tag> id)]
+...          (format <pre> (%.nat id) <post>)])
+...       ([#.Var "⌈v:" "⌋"]
+...        [#.Ex  "⟨e:" "⟩"])
+
+...       (^template [<tag> <name> <flat>]
+...         [[_ (<tag> _)]
+...          (let [[level' body] (<flat> type)
+...                args (level_parameters level level')
+...                body_doc (pprint_type_definition (n.+ level level') type_function_info tags module interface? recursive_type? body)]
+...            (format "(" <name> " " "[" (text.interposed " " args) "]"
+...                    (case tags
+...                      #.End
+...                      (format " " body_doc)
+
+...                      _
+...                      (format text.new_line (prefix_lines "  " body_doc)))
+...                    ")"))])
+...       ([#.UnivQ "All" type.flat_univ_q]
+...        [#.ExQ   "Ex"  type.flat_ex_q])
+
+...       [true (#.Apply (#.Parameter 1) (#.Parameter 0))]
+...       (product.left type_function_info)
+
+...       [_ (#.Apply param fun)]
+...       (let [[type_func type_arguments] (type.flat_application type)]
+...         (format  "(" (pprint_type_definition level type_function_info tags module interface? recursive_type? type_func) " " (|> type_arguments (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) ")"))
+
+...       [_ (#.Named [_module _name] type)]
+...       (if (text\= module _module)
+...         _name
+...         (%.name [_module _name]))
+...       )))
 
 ... (def: (pprint_type level type_function_name module type)
 ...   (-> Nat Text Text Type Text)
-- 
cgit v1.2.3