aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/base.lux
blob: 8660d7ccfd69263b48003bde334d08d8da1b314a (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
(;module:
  lux
  (lux (control monad)
       (data [text "T/" Eq<Text>]
             text/format
             ["E" error])
       [macro #+ Monad<Lux>]
       (type ["TC" check])))

(type: #export Path Text)

(type: #export Mode
  #Release
  #Debug)

(def: #export (fail message)
  (All [a] (-> Text (Lux a)))
  (do Monad<Lux>
    [[file line col] macro;cursor
     #let [location (format file
                            "," (|> line nat-to-int %i)
                            "," (|> col nat-to-int %i))]]
    (macro;fail (format "@ " location
                        "\n" message))))

(def: #export (with-expected-type expected action)
  (All [a] (-> Type (Lux a) (Lux a)))
  (function [compiler]
    (case (action (set@ #;expected (#;Some expected) compiler))
      (#E;Success [compiler' output])
      (let [old-expected (get@ #;expected compiler)]
        (#E;Success [(set@ #;expected old-expected compiler')
                     output]))

      (#E;Error error)
      (#E;Error error))))

(def: #export (within-type-env action)
  (All [a] (-> (TC;Check a) (Lux a)))
  (function [compiler]
    (case (action (get@ #;type-context compiler))
      (#E;Error error)
      (#E;Error error)

      (#E;Success [context' output])
      (#E;Success [(set@ #;type-context context' compiler)
                   output]))))

(def: #export (pl::put key val table)
  (All [a] (-> Text a (List [Text a]) (List [Text a])))
  (case table
    #;Nil
    (list [key val])

    (#;Cons [k' v'] table')
    (if (T/= key k')
      (#;Cons [key val]
              table')
      (#;Cons [k' v']
              (pl::put key val table')))))

(def: #export (pl::get key table)
  (All [a] (-> Text (List [Text a]) (Maybe a)))
  (case table
    #;Nil
    #;None

    (#;Cons [k' v'] table')
    (if (T/= key k')
      (#;Some v')
      (pl::get key table'))))

(def: #export (with-source-code source action)
  (All [a] (-> [Cursor Text] (Lux a) (Lux a)))
  (function [compiler]
    (let [old-source (get@ #;source compiler)]
      (case (action (set@ #;source source compiler))
        (#E;Error error)
        (#E;Error error)

        (#E;Success [compiler' output])
        (#E;Success [(set@ #;source old-source compiler')
                     output])))))