blob: 7e3846c0982cd7acc08c78fd2f0d33286388b415 (
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
|
(.module:
[lux #*
[control
[monad (#+ do)]]
[data
["." product]
["." error]]
[world
["." file (#+ File)]]]
[//
["." init]
["." syntax]
["/." //
["." phase
["." translation]
["." statement]]
["." cli (#+ Configuration)]
[meta
["." archive]
[io
["." context]]]]])
(type: #export (Platform ! anchor expression statement)
{#host (translation.Host expression statement)
#phase (translation.Phase anchor expression statement)
#runtime (translation.Operation anchor expression statement Any)
#file-system (file.System !)})
## (def: (write-module target-dir file-name module-name module outputs)
## (-> File Text Text Module Outputs (Process Any))
## (do (error.with-error 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 platform translation-bundle)
(All [! anchor expression statement]
(-> <Platform> <Bundle> (! <State+>)))
(|> platform
(get@ #runtime)
statement.lift-translation
(phase.run' (init.state (get@ #host platform)
(get@ #phase platform)
translation-bundle))
(:: error.functor map product.left)
(:: (get@ #file-system platform) lift))
## (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 platform configuration state)
(All [! anchor expression statement]
(-> <Platform> Configuration <State+> (! Any)))
(do (:: (get@ #file-system platform) &monad)
[input (context.read (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)
]
## (case (compiler input)
## (#error.Failure error)
## (:: (get@ #file-system platform) lift (#error.Failure error))
## (#error.Success))
(let [compiler (init.compiler syntax.prelude state)
compilation (compiler init.key (list) input)]
(case ((get@ #///.process compilation)
archive.empty)
(#error.Success more|done)
(case more|done
(#.Left more)
(:: (get@ #file-system platform) lift (#error.Failure "NOT DONE!"))
(#.Right done)
(wrap []))
(#error.Failure error)
(:: (get@ #file-system platform) lift (#error.Failure error))))))
)
|
