blob: bd1efd73bd6657c69419385b32ef2585defc2bb3 (
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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
(.module:
[lux (#- Module Code)
["@" target]
[abstract
[monad (#+ Monad do)]]
[control
["ex" exception (#+ Exception exception:)]
[security
["!" capability]]]
[data
["." error (#+ Error)]
["." text ("#;." hash)
format
["." encoding]]]
[world
["." file (#+ Path File)]
[binary (#+ Binary)]]
[type (#+ :share)]]
["." // (#+ Context Code)
["#/" // #_
[archive
[descriptor (#+ Module)]]
["#/" // (#+ Input)]]])
(template [<name>]
[(exception: #export (<name> {module Module})
(ex.report ["Module" module]))]
[cannot-find-module]
[cannot-read-module]
)
(type: #export Extension Text)
(def: lux-extension
Extension
".lux")
(def: partial-host-extension
Extension
(`` (for {(~~ (static @.common-lisp)) ".cl"
(~~ (static @.js)) ".js"
(~~ (static @.old)) ".jvm"
(~~ (static @.jvm)) ".jvm"
(~~ (static @.lua)) ".lua"
(~~ (static @.php)) ".php"
(~~ (static @.python)) ".py"
(~~ (static @.r)) ".r"
(~~ (static @.ruby)) ".rb"
(~~ (static @.scheme)) ".scm"})))
(def: full-host-extension
Extension
(format partial-host-extension lux-extension))
(def: #export (path system context module)
(All [m] (-> (file.System m) Context Module Path))
(|> module
(//.sanitize system)
(format context (:: system separator))))
(def: (find-source-file monad system contexts module extension)
(All [!]
(-> (Monad !) (file.System !) (List Context) Module Extension
(! (Error [Path (File !)]))))
(case contexts
#.Nil
(:: monad wrap (ex.throw ..cannot-find-module [module]))
(#.Cons context contexts')
(do monad
[#let [path (format (..path system context module) extension)]
file (!.use (:: system file) path)]
(case file
(#error.Success file)
(wrap (#error.Success [path file]))
(#error.Failure error)
(find-source-file monad system contexts' module extension)))))
(def: #export (find-any-source-file monad system contexts module)
(All [!]
(-> (Monad !) (file.System !) (List Context) Module
(! (Error [Path (File !)]))))
(do monad
[outcome (find-source-file monad system contexts module ..full-host-extension)]
(case outcome
(#error.Success output)
(wrap outcome)
(#error.Failure error)
(find-source-file monad system contexts module ..lux-extension))))
(def: #export (read monad system contexts module)
(All [!]
(-> (Monad !) (file.System !) (List Context) Module
(! (Error Input))))
(do (error.with monad)
[## TODO: Get rid of both ":share"s ASAP
path,file (:share [!]
{(Monad !)
monad}
{(! (Error [Path (File !)]))
(find-any-source-file monad system contexts module)})
#let [[path file] (:share [!]
{(Monad !)
monad}
{[Path (File !)]
path,file})]
binary (!.use (:: file content) [])]
(case (encoding.from-utf8 binary)
(#error.Success code)
(wrap {#////.module module
#////.file path
#////.hash (text;hash code)
#////.code code})
(#error.Failure _)
(:: monad wrap (ex.throw ..cannot-read-module [module])))))
|