blob: 959478f28452cc0e8d59cfef11b2e934d924aea3 (
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
|
(.module:
[lux #*
[control
[monad (#+ Monad do)]]
[data
["." product]
["." error (#+ Error)]]
[world
["." file (#+ File)]]]
[//
["." init]
["." syntax]
["/." //
["." phase
[macro (#+ Expander)]
["." translation]
["." statement]]
["." cli (#+ Configuration)]
[meta
["." archive]
[io
["." context]]]]])
(type: #export (Platform ! anchor expression statement)
{#&monad (Monad !)
#&file-system (file.System !)
#host (translation.Host expression statement)
#phase (translation.Phase anchor expression statement)
#runtime (translation.Operation anchor expression statement Any)})
## (def: (write-module target-dir file-name module-name module outputs)
## (-> File Text Text Module Outputs (Process Any))
## (do (error.with io.monad)
## [_ (monad.map @ (product.uncurry (&io.write target-dir))
## (dictionary.entries outputs))]
## (&io.write target-dir
## (format module-name "/" cache.descriptor-name)
## (encoding.to-utf8 (%code (cache/description.write file-name module))))))
(with-expansions [<Platform> (as-is (Platform ! anchor expression statement))
<State+> (as-is (statement.State+ anchor expression statement))
<Bundle> (as-is (translation.Bundle anchor expression statement))]
(def: #export (initialize expander platform translation-bundle)
(All [! anchor expression statement]
(-> Expander <Platform> <Bundle> (! (Error <State+>))))
(|> platform
(get@ #runtime)
statement.lift-translation
(phase.run' (init.state expander
(get@ #host platform)
(get@ #phase platform)
translation-bundle))
(:: error.functor map product.left)
(:: (get@ #&monad platform) wrap))
## (case (runtimeT.translate ## (initL.compiler (io.run js.init))
## (initL.compiler (io.run hostL.init-host))
## )
## ## (#error.Success [state disk-write])
## ## (do @
## ## [_ (&io.prepare-target target)
## ## _ disk-write
## ## ## _ (cache/io.pre-load sources target (commonT.load-definition state))
## ## ]
## ## (wrap (|> state
## ## (set@ [#.info #.mode] #.Build))))
## (#error.Success [state [runtime-bc function-bc]])
## (do @
## [_ (&io.prepare-target target)
## ## _ (&io.write target (format hostL.runtime-class ".class") runtime-bc)
## ## _ (&io.write target (format hostL.function-class ".class") function-bc)
## ## _ (cache/io.pre-load sources target (commonT.load-definition state))
## ]
## (wrap (|> state
## (set@ [#.info #.mode] #.Build))))
## (#error.Failure error)
## (io.fail error))
)
(def: #export (compile expander platform configuration state)
(All [! anchor expression statement]
(-> Expander <Platform> Configuration <State+> (! (Error Any))))
(let [monad (get@ #&monad platform)]
(do monad
[input (context.read monad
(get@ #&file-system platform)
(get@ #cli.sources configuration)
(get@ #cli.module configuration))
## _ (&io.prepare-module target-dir (get@ #cli.module configuration))
## _ (write-module target-dir file-name (get@ #cli.module configuration) module outputs)
]
(wrap (do error.monad
[input input
#let [compile (init.compiler expander syntax.prelude state)
compilation (compile init.key (list) input)]]
(case ((get@ #///.process compilation)
archive.empty)
(#error.Success more|done)
(case more|done
(#.Left more)
(#error.Failure "NOT DONE!")
(#.Right done)
(wrap []))
(#error.Failure error)
(#error.Failure error))))
## (case (compile input)
## (#error.Failure error)
## (:: monad wrap (#error.Failure error))
## (#error.Success))
)))
)
|
