blob: a15e9b2b0486bc384301b2e1d6c5558398175b11 (
plain)
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
94
95
96
|
(.using
[library
[lux (.full)
["[0]" meta]
["[0]" type]
[abstract
["[0]" monad (.only do)]]
[control
["[0]" maybe]
["<>" parser ("[1]#[0]" monad)
["<[0]>" type (.only Env)]
["<[0]>" code (.only Parser)]]]
[data
["[0]" product]
["[0]" text]
[collection
["[0]" list ("[1]#[0]" functor)]
["[0]" dictionary]]]
[macro (.only with_symbols)
[syntax (.only syntax:)]
["^" pattern]
["[0]" code]]
[math
[number
["n" nat]]]]])
(def: polyP
(Parser [Code Text Code])
(let [private (all <>.and
<code>.local
<code>.any)]
(<>.either (<>.and <code>.any private)
(<>.and (<>#in (` .private)) private))))
(syntax: .public (poly: [[export_policy name body] ..polyP])
(with_symbols [g!_ g!type g!output]
(let [g!name (code.symbol ["" name])]
(in (.list (` ((~! syntax:) (~ export_policy) ((~ g!name) [(~ g!type) (~! <code>.any)])
((~! do) (~! meta.monad)
[(~ g!type) ((~! meta.eval) .Type (~ g!type))]
(case (is (.Either .Text .Code)
((~! <type>.result) ((~! <>.rec)
(function ((~ g!_) (~ g!name))
(~ body)))
(.as .Type (~ g!type))))
{.#Left (~ g!output)}
((~! meta.failure) (~ g!output))
{.#Right (~ g!output)}
((~' in) (.list (~ g!output))))))))))))
(def: .public (code env type)
(-> Env Type Code)
(`` (case type
{.#Primitive name params}
(` {.#Primitive (~ (code.text name))
(.list (~+ (list#each (code env) params)))})
(^.template [<tag>]
[{<tag> idx}
(` {<tag> (~ (code.nat idx))})])
([.#Var] [.#Ex])
{.#Parameter idx}
(let [idx (<type>.argument env idx)]
(if (n.= 0 idx)
(|> (dictionary.value idx env) maybe.trusted product.left (code env))
(` (.$ (~ (code.nat (-- idx)))))))
{.#Apply {.#Primitive "" {.#End}}
{.#Parameter idx}}
(case (<type>.argument env idx)
0 (|> env (dictionary.value 0) maybe.trusted product.left (code env))
idx (undefined))
(^.template [<tag>]
[{<tag> left right}
(` {<tag> (~ (code env left))
(~ (code env right))})])
([.#Function] [.#Apply])
(^.template [<macro> <tag> <flattener>]
[{<tag> left right}
(` (<macro> (~+ (list#each (code env) (<flattener> type)))))])
([.Union .#Sum type.flat_variant]
[.Tuple .#Product type.flat_tuple])
{.#Named name sub_type}
(code.symbol name)
(^.template [<tag>]
[{<tag> scope body}
(` {<tag> (.list (~+ (list#each (code env) scope)))
(~ (code env body))})])
([.#UnivQ] [.#ExQ])
)))
|
