blob: 4e18836d7a26a4b8d5fc838390dd9c13c0344888 (
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
|
(;module: {#;doc "Exception-handling functionality built on top of the Error type."}
lux
(lux (control monad)
(data [error #- fail]
[text])
[compiler]
(macro [ast]
["s" syntax #+ syntax: Syntax]
(syntax [common]))))
## [Types]
(type: #export Exception
{#;doc "An exception provides a way to decorate error messages."}
(-> Text Text))
## [Values]
(def: #hidden _Text/append_
(-> Text Text Text)
(:: text;Monoid<Text> append))
(def: #export (catch exception then try)
{#;doc "If a particular exception is detected on a possibly-erroneous value, handle it.
If no exception was detected, or a different one from the one being checked, then pass along the original value."}
(All [a]
(-> Exception (-> Text a) (Error a)
(Error a)))
(case try
(#;Right output)
(#;Right output)
(#;Left error)
(if (text;starts-with? (exception "") error)
(#;Right (then error))
(#;Left error))))
(def: #export (otherwise to-do try)
{#;doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."}
(All [a]
(-> (-> Text a) (Error a) a))
(case try
(#;Right output)
output
(#;Left error)
(to-do error)))
(def: #export (return value)
{#;doc "A way to lift normal values into the error-handling context."}
(All [a] (-> a (Error a)))
(#;Right value))
(def: #export (throw exception message)
{#;doc "Decorate an error message with an Exception and lift it into the error-handling context."}
(All [a] (-> Exception Text (Error a)))
(#;Left (exception message)))
(syntax: #export (exception: [_ex-lev common;export-level] [name s;local-symbol])
{#;doc (doc "Define a new exception type."
"It moslty just serves as a way to tag error messages for later catching."
(exception: #export Some-Exception))}
(do @
[current-module compiler;current-module-name
#let [g!message (ast;symbol ["" "message"])]]
(wrap (list (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name])) (~ g!message))
Exception
($_ _Text/append_ "[" (~ (ast;text current-module)) ";" (~ (ast;text name)) "]\t" (~ g!message))))))))
|
