blob: 4ac865786c886a8662142a666240dbfefe9689ae (
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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
(;module:
lux
(lux (control monad)
(concurrency ["P" promise])
(data ["E" error]
[text "T/" Hash<Text>]
text/format)
[macro #+ Monad<Lux>])
(luxc ["&" base]
["&;" io]
["&;" module]
["&;" parser]
(compiler ["&&;" runtime]
["&&;" statement])
))
(def: (compile ast)
(-> AST (Lux Unit))
(case ast
(^ [_ (#;FormS (list [_ (#;SymbolS ["" "_lux_def"])]
[_ (#;SymbolS ["" def-name])]
def-value
def-meta))])
(&&statement;compile-def def-name def-value def-meta)
(^ [_ (#;FormS (list [_ (#;SymbolS ["" "_lux_program"])]
[_ (#;SymbolS ["" prog-args])]
prog-body))])
(&&statement;compile-program prog-args prog-body)
_
(&;fail (format "Unrecognized statement: " (%ast ast)))))
(def: (exhaust action)
(All [a] (-> (Lux a) (Lux Unit)))
(do Monad<Lux>
[result action]
(exhaust action)))
(def: (ensure-new-module! file-hash module-name)
(-> Nat Text (Lux Unit))
(do Monad<Lux>
[module-exists? (macro;module-exists? module-name)
_ (: (Lux Unit)
(if module-exists?
(&;fail (format "Cannot re-define a module: " module-name))
(wrap [])))
_ (&module;create file-hash module-name)]
(wrap [])))
(def: prelude Text "lux")
(def: (with-active-compilation [module-name file-name source-code] action)
(All [a] (-> [Text Text Text] (Lux a) (Lux a)))
(do Monad<Lux>
[_ (ensure-new-module! (T/hash source-code) module-name)
#let [init-cursor [file-name +0 +0]]
output (&;with-source-code [init-cursor source-code]
action)
_ (&module;flag-compiled! module-name)]
(wrap output)))
(def: parse
(Lux AST)
(function [compiler]
(case (&parser;parse (get@ #;source compiler))
(#E;Error error)
(#E;Error error)
(#E;Success [source' output])
(#E;Success [(set@ #;source source' compiler)
output]))))
(def: (compile-module source-dirs module-name compiler)
(-> (List &;Path) Text Compiler (P;Promise (E;Error Compiler)))
(do P;Monad<Promise>
[?input (&io;read-module source-dirs module-name)]
(case ?input
(#E;Success [file-name file-content])
(let [compilation (do Monad<Lux>
[_ (with-active-compilation [module-name
file-name
file-content]
(exhaust
(do @
[ast parse]
(compile ast))))]
(wrap [])
## (&module;generate-descriptor module-name)
)]
(case (macro;run' compiler compilation)
(#E;Success [compiler module-descriptor])
(do @
[## _ (&io;write-module module-name module-descriptor)
]
(wrap (#E;Success compiler)))
(#E;Error error)
(wrap (#E;Error error))))
(#E;Error error)
(wrap (#E;Error error)))))
(type: Host Unit)
(def: init-host Host [])
(def: init-cursor Cursor ["" +0 +0])
(def: init-type-context
Type-Context
{#;ex-counter +0
#;var-counter +0
#;var-bindings (list)})
(def: compiler-version Text "0.6.0")
(def: init-compiler-info
Compiler-Info
{#;compiler-version compiler-version
#;compiler-mode #;Release})
(def: (init-compiler host)
(-> Host Compiler)
{#;info init-compiler-info
#;source [init-cursor ""]
#;cursor init-cursor
#;modules (list)
#;scopes (list)
#;type-context init-type-context
#;expected #;None
#;seed +0
#;scope-type-vars (list)
#;host (:! Void host)})
(def: (or-crash! action)
(All [a] (-> (P;Promise (E;Error a)) (P;Promise a)))
(do P;Monad<Promise>
[?output action]
(case ?output
(#E;Error error)
(error! error)
(#E;Success output)
(wrap output))))
(def: #export (compile-program mode program target sources)
(-> &;Mode &;Path &;Path (List &;Path) (P;Promise Unit))
(do P;Monad<Promise>
[#let [compiler (init-compiler init-host)]
_ (or-crash! (&&runtime;compile-runtime []))
compiler (or-crash! (compile-module sources prelude compiler))
compiler (or-crash! (compile-module sources program compiler))
#let [_ (log! "Compilation complete!")]]
(wrap [])))
|
