aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/module.lux
blob: 1e61741434adc0119e635b6f34905940a43c212f (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
(;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 (define (^@ full-name [module-name def-name])
                      definition)
  (-> Ident Def (Lux Unit))
  (function [compiler]
    (case (&;pl-get module-name (get@ #;modules compiler))
      (#;Some module)
      (case (&;pl-get def-name (get@ #;defs module))
        #;None
        (#E;Success [(update@ #;modules
                              (&;pl-put module-name
                                        (update@ #;defs
                                                 (: (-> (List [Text Def]) (List [Text Def]))
                                                    (|>. (#;Cons [def-name definition])))
                                                 module))
                              compiler)
                     []])

        (#;Some already-existing)
        (#E;Error (format "Cannot re-define definiton: " (%ident full-name))))

      #;None
      (#E;Error (format "Cannot define in unknown module: " module-name)))))

(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)
         (let [active? (case (get@ #;module-state module)
                         #;Active true
                         _     false)]
           (if active?
             (#E;Success [(update@ #;modules
                                   (&;pl-put module-name (set@ #;module-state <tag> module))
                                   compiler)
                          []])
             (#E;Error "Can only change the state of a currently-active module.")))

         #;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]
  )