blob: 14f55f106e4c9ca2b0f7b0051f6fc4037c0af388 (
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
|
(.module:
[library
[lux (#- nat int rev)
[abstract
["." monad (#+ do)]]
[data
["." maybe]
["." name ("#\." equivalence)]]]])
(type: #export Annotation
Code)
(def: #export (value tag ann)
(-> Name Annotation (Maybe Code))
(case ann
[_ (#.Record ann)]
(loop [ann ann]
(case ann
(#.Cons [key value] ann')
(case key
[_ (#.Tag tag')]
(if (name\= tag tag')
(#.Some value)
(recur ann'))
_
(recur ann'))
#.Nil
#.None))
_
#.None))
(template [<name> <tag> <type>]
[(def: #export (<name> tag ann)
(-> Name Annotation (Maybe <type>))
(case (..value tag ann)
(#.Some [_ (<tag> value)])
(#.Some value)
_
#.None))]
[bit #.Bit Bit]
[nat #.Nat Nat]
[int #.Int Int]
[rev #.Rev Rev]
[frac #.Frac Frac]
[text #.Text Text]
[identifier #.Identifier Name]
[tag #.Tag Name]
[form #.Form (List Code)]
[tuple #.Tuple (List Code)]
[record #.Record (List [Code Code])]
)
(def: #export documentation
(-> Annotation (Maybe Text))
(..text (name_of #.doc)))
(def: #export (flagged? flag)
(-> Name Annotation Bit)
(|>> (..bit flag) (maybe.default false)))
(template [<name> <tag>]
[(def: #export <name>
(-> Annotation Bit)
(..flagged? (name_of <tag>)))]
[implementation? #.implementation?]
[recursive_type? #.type-rec?]
[signature? #.sig?]
)
(def: (text_parser input)
(-> Code (Maybe Text))
(case input
[_ (#.Text actual_value)]
(#.Some actual_value)
_
#.None))
(template [<name> <tag>]
[(def: #export (<name> ann)
(-> Annotation (List Text))
(maybe.default (list)
(do {! maybe.monad}
[args (..tuple (name_of <tag>) ann)]
(monad.map ! ..text_parser args))))]
[function_arguments #.func-args]
[type_arguments #.type-args]
)
|