blob: 8288718aa317a102220379df6ef4174dd1b428ba (
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
|
(.module:
[lux (#- Module Code)
[control
monad
["ex" exception (#+ Exception exception:)]]
[data
["." error]
[text
format
["." encoding]]]
[world
["." file (#+ File System)]
[binary (#+ Binary)]]]
["." // (#+ Context Module)
[////
["." host]]])
(type: #export Extension Text)
(def: #export (file System<m> context module)
(All [m] (-> (System m) Context Module File))
(|> module
(//.sanitize System<m>)
(format context (:: System<m> separator))))
(def: host-extension
Extension
(`` (for {(~~ (static host.common-lisp)) ".cl"
(~~ (static host.js)) ".js"
(~~ (static host.jvm)) ".jvm"
(~~ (static host.lua)) ".lua"
(~~ (static host.php)) ".php"
(~~ (static host.python)) ".py"
(~~ (static host.r)) ".r"
(~~ (static host.ruby)) ".rb"
(~~ (static host.scheme)) ".scm"})))
(def: lux-extension Extension ".lux")
(do-template [<name>]
[(exception: #export (<name> {module Module})
(ex.report ["Module" module]))]
[module-not-found]
[cannot-read-module]
)
(def: (find-source System<m> contexts module extension)
(All [m] (-> (System m) (List Context) Module Text (m (Maybe [Module File]))))
(case contexts
#.Nil
(:: (:: System<m> &monad) wrap #.None)
(#.Cons context contexts')
(do (:: System<m> &monad)
[#let [file (format (..file System<m> context module) extension)]
? (file.exists? System<m> file)]
(if ?
(wrap (#.Some [module file]))
(find-source System<m> contexts' module)))))
(def: (try System<m> computations exception message)
(All [m a e] (-> (System m) (List (m (Maybe a))) (Exception e) e (m a)))
(case computations
#.Nil
(:: System<m> throw exception message)
(#.Cons computation computations')
(do (:: System<m> &monad)
[outcome computation]
(case outcome
(#.Some output)
(wrap output)
#.None
(try System<m> computations' exception message)))))
(type: #export Code Text)
(def: #export (read System<m> contexts name)
(All [m] (-> (System m) (List Context) Module (m [Text Code])))
(let [find-source' (find-source System<m> contexts name)]
(do (:: System<m> &monad)
[[path file] (try System<m>
(list (find-source' (format host-extension lux-extension))
(find-source' lux-extension))
module-not-found [name])
binary (:: System<m> read file)]
(case (encoding.from-utf8 binary)
(#error.Success code)
(wrap [path code])
(#error.Error _)
(:: System<m> throw cannot-read-module [name])))))
|