aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang.lux
blob: 28dd302c26c045c81c288174a8468f3620b8eec3 (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
(.module:
  lux
  (lux (control [monad #+ do]
                ["ex" exception #+ exception:])
       (data [maybe]
             [product]
             ["e" error]
             [text "text/" Eq<Text>]
             text/format
             (coll [list]))
       [macro]
       (macro ["s" syntax #+ syntax:])
       (lang (type ["tc" check])))
  (luxc (lang ["la" analysis])))

(def: (normalize-char char)
  (-> Nat Text)
  (case char
    (^ (char "*")) "_ASTER_"
    (^ (char "+")) "_PLUS_"
    (^ (char "-")) "_DASH_"
    (^ (char "/")) "_SLASH_"
    (^ (char "\\")) "_BSLASH_"
    (^ (char "_")) "_UNDERS_"
    (^ (char "%")) "_PERCENT_"
    (^ (char "$")) "_DOLLAR_"
    (^ (char "'")) "_QUOTE_"
    (^ (char "`")) "_BQUOTE_"
    (^ (char "@")) "_AT_"
    (^ (char "^")) "_CARET_"
    (^ (char "&")) "_AMPERS_"
    (^ (char "=")) "_EQ_"
    (^ (char "!")) "_BANG_"
    (^ (char "?")) "_QM_"
    (^ (char ":")) "_COLON_"
    (^ (char ".")) "_PERIOD_"
    (^ (char ",")) "_COMMA_"
    (^ (char "<")) "_LT_"
    (^ (char ">")) "_GT_"
    (^ (char "~")) "_TILDE_"
    (^ (char "|")) "_PIPE_"
    _
    (text.from-code char)))

(def: underflow Nat (n/dec +0))

(def: #export (normalize-name name)
  (-> Text Text)
  (loop [idx (n/dec (text.size name))
         output ""]
    (if (n/= underflow idx)
      output
      (recur (n/dec idx) (format (|> (text.nth idx name) maybe.assume normalize-char) output)))))

(exception: #export (Error {message Text})
  message)

(def: #export (with-error-tracking action)
  (All [a] (-> (Meta a) (Meta a)))
  (function (_ compiler)
    (case (action compiler)
      (#e.Error error)
      ((throw Error error) compiler)

      output
      output)))