aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/compositor.lux
blob: 5fb90837f0f456a2ff5b57dde97e6c9299d6c16e (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
(.module:
  [lux #*
   [type (#+ :share)]
   [cli (#+ program:)]
   ["." io (#+ IO io)]
   [control
    [monad (#+ do)]]
   [data
    ["." error (#+ Error)]
    ["." text
     format]]
   [time
    ["." instant (#+ Instant)]]
   [world
    ["." console]]
   [tool
    [compiler
     ["." statement]
     [phase
      [macro (#+ Expander)]
      ["." generation]]
     [default
      ["." platform (#+ Platform)]
      ["." syntax]]
     [meta
      ["." archive (#+ Archive)]]]
    ## ["." interpreter]
    ]]
  [/
   ["." cli (#+ Service)]])

(def: (or-crash! failure-description action)
  (All [a]
    (-> Text (IO (Error a)) (IO a)))
  (do io.monad
    [?output action]
    (case ?output
      (#error.Failure error)
      (exec (log! (format text.new-line
                          failure-description text.new-line
                          error text.new-line))
        (io.exit +1))

      (#error.Success output)
      (wrap output))))

(def: (timed action)
  (All [a]
    (-> (-> Any (IO (Error a))) (IO (Error a))))
  (do (error.with io.monad)
    [start (: (IO (Error Instant))
              (error.lift io.monad instant.now))
     result (action [])
     finish (: (IO (Error Instant))
               (error.lift io.monad instant.now))
     #let [elapsed-time (instant.span start finish)
           _ (log! (format text.new-line
                           "Elapsed time: " (%duration elapsed-time)))]]
    (wrap result)))

(def: #export (compiler expander platform bundle service)
  (All [anchor expression statement]
    (-> Expander
        (IO (Platform IO anchor expression statement))
        (generation.Bundle anchor expression statement)
        Service
        (IO Any)))
  (do io.monad
    [platform platform
     console (:: @ map error.assume console.system)]
    (case service
      (#cli.Compilation configuration)
      (<| (or-crash! "Compilation failed:")
          ..timed
          (function (_ _)
            (do (error.with io.monad)
              [state (:share [anchor expression statement]
                             {(Platform IO anchor expression statement)
                              platform}
                             {(IO (Error (statement.State+ anchor expression statement)))
                              (platform.initialize expander platform bundle)})
               _ (:share [anchor expression statement]
                         {(Platform IO anchor expression statement)
                          platform}
                         {(IO (Error [Archive (statement.State+ anchor expression statement)]))
                          (platform.compile expander platform configuration archive.empty state)})
               ## _ (cache/io.clean target ...)
               ]
              (wrap (log! "Compilation complete!")))))
      
      (#cli.Interpretation configuration)
      ## TODO: Fix the interpreter...
      (undefined)
      ## (<| (or-crash! "Interpretation failed:")
      ##     (interpreter.run (error.with io.monad) console platform configuration bundle))
      )))