diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/library/lux/meta/annotation.lux | 95 |
1 files changed, 95 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/meta/annotation.lux b/stdlib/source/library/lux/meta/annotation.lux new file mode 100644 index 000000000..1b7ee480b --- /dev/null +++ b/stdlib/source/library/lux/meta/annotation.lux @@ -0,0 +1,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: (parse_text 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 ! ..parse_text args))))] + + [function_arguments #.func-args] + [type_arguments #.type-args] + ) |