aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/program')
-rw-r--r--stdlib/source/program/scriptum.lux224
1 files changed, 112 insertions, 112 deletions
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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 00:25:05 +0000