1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
(.require
[library
[lux (.except)
[abstract
["[0]" monad (.only do)]]
[control
["<>" parser (.use "[1]#[0]" monad)]
["[0]" maybe]]
[data
["[0]" product]
["[0]" text]
[collection
["[0]" list (.use "[1]#[0]" functor)]
["[0]" dictionary]]]
[math
[number
["n" nat]]]
[meta
["[0]" code (.only)
["<[1]>" \\parser (.only Parser)]]
[macro (.only with_symbols)
[syntax (.only syntax)]
["^" pattern]]]]]
["[0]" // (.only)
["<[1]>" \\parser (.only Env)]
["/[1]" //]])
(def .public polytypic
(syntax (_ [name <code>.local
body <code>.any])
(with_symbols [g!_ g!type g!output]
(let [g!name (code.symbol ["" name])]
(in (.list (` (syntax ((, g!_) [(, g!type) <code>.any])
(do ///.monad
[(, g!type) (///.eval .Type (, g!type))]
(when (is (.Either .Text .Code)
(<//>.result (<>.rec
(function ((, g!_) (, g!name))
(, body)))
(.as .Type (, g!type))))
{.#Right (, g!output)}
(at ///.monad (,' in) (.list (, g!output)))
{.#Left (, g!output)}
(///.failure (, g!output))))))))))))
(def .public (code env type)
(-> Env Type Code)
(when type
{.#Nominal name params}
(` {.#Nominal (, (code.text name))
(.list (,* (list#each (code env) params)))})
(^.with_template [<tag>]
[{<tag> idx}
(` {<tag> (, (code.nat idx))})])
([.#Var]
[.#Ex])
{.#Parameter idx}
(let [idx (<//>.argument env idx)]
(if (n.= 0 idx)
(|> (dictionary.value idx env) maybe.trusted product.left (code env))
(` (.$ (, (code.nat (-- idx)))))))
{.#Apply {.#Nominal "" {.#End}}
{.#Parameter idx}}
(when (<//>.argument env idx)
0 (|> env (dictionary.value 0) maybe.trusted product.left (code env))
idx (undefined))
(^.with_template [<tag>]
[{<tag> left right}
(` {<tag> (, (code env left))
(, (code env right))})])
([.#Function]
[.#Apply])
(^.with_template [<macro> <tag> <flattener>]
[{<tag> left right}
(` (<macro> (,* (list#each (code env) (<flattener> type)))))])
([.Union .#Sum //.flat_variant]
[.Tuple .#Product //.flat_tuple])
{.#Named name sub_type}
(code.symbol name)
(^.with_template [<tag>]
[{<tag> scope body}
(` {<tag> (.list (,* (list#each (code env) scope)))
(, (code env body))})])
([.#UnivQ]
[.#ExQ])))
|
