aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/meta/annotation.lux
blob: 27512d5f615cb211b475ec2f1127e4c26ac13fca (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
        (#.Item [key value] ann')
        (case key
          [_ (#.Tag tag')]
          (if (name\= tag tag')
            (#.Some value)
            (recur ann'))

          _
          (recur ann'))
        
        #.End
        #.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]
  )