aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/module.lux
blob: e5848fccbf909a9f512c4ce95e092b2017b978b1 (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
(;module:
  lux
  (lux (control monad)
       (data [text "T/" Eq<Text>]
             text/format
             ["E" error]))
  (luxc ["&" base]))

(def: (new-module hash)
  (-> Nat Module)
  {#;module-hash    hash
   #;module-aliases (list)
   #;defs           (list)
   #;imports        (list)
   #;tags           (list)
   #;types          (list)
   #;module-anns    (list)
   #;module-state   #;Active})

(def: #export (create hash name)
  (-> Nat Text (Lux Module))
  (function [compiler]
    (let [module (new-module hash)]
      (#E;Success [(update@ #;modules
                            (&;pl::put name module)
                            compiler)
                   module]))))

(do-template [<flagger> <asker> <tag>]
  [(def: #export (<flagger> module-name)
     (-> Text (Lux Unit))
     (function [compiler]
       (case (|> compiler (get@ #;modules) (&;pl::get module-name))
         (#;Some module)
         (#E;Success [(update@ #;modules
                               (&;pl::put module-name (set@ #;module-state <tag> module))
                               compiler)
                      []])

         #;None
         (#E;Error (format "Module does not exist: " module-name)))))
   (def: #export (<asker> module-name)
     (-> Text (Lux Bool))
     (function [compiler]
       (case (|> compiler (get@ #;modules) (&;pl::get module-name))
         (#;Some module)
         (#E;Success [compiler
                      (case (get@ #;module-state module)
                        <tag> true
                        _     false)])

         #;None
         (#E;Error (format "Module does not exist: " module-name)))
       ))]

  [flag-active!   active?   #;Active]
  [flag-compiled! compiled? #;Compiled]
  [flag-cached!   cached?   #;Cached]
  )