aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data/number.lux
blob: 07e0938494d080989d6f5dfb608a77b8b4fe80ef (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 #*
   [abstract
    [codec (#+ Codec)]]
   [control
    ["." try (#+ Try)]]
   [data
    ["." text]]]
  ["." / #_
   ["#." nat]
   ["#." int]
   ["#." rev]
   ["#." frac]])

(macro: (encoding-doc tokens state)
  (case tokens
    (^ (list [cursor (#.Text encoding)] example-1 example-2))
    (let [encoding ($_ "lux text concat"
                       "Given syntax for a "
                       encoding
                       " number, generates a Nat, an Int, a Rev or a Frac.")
          commas "Allows for the presence of commas among the digits."
          description [cursor (#.Text ($_ "lux text concat" encoding " " commas))]]
      (#try.Success [state (list (` (doc (~ description)
                                         (~ example-1)
                                         (~ example-2))))]))

    _
    (#try.Failure "Wrong syntax for 'encoding-doc'.")))

(def: (comma-prefixed? number)
  (-> Text Bit)
  (case ("lux text index" 0 "," number)
    (#.Some 0)
    #1

    _
    #0))

(def: clean-commas
  (-> Text Text)
  (text.replace-all "," ""))

(template [<macro> <nat> <int> <rev> <frac> <error> <doc>]
  [(macro: #export (<macro> tokens state)
     {#.doc <doc>}
     (case tokens
       (#.Cons [meta (#.Text repr')] #.Nil)
       (if (comma-prefixed? repr')
         (#try.Failure <error>)
         (let [repr (clean-commas repr')]
           (case (:: <nat> decode repr)
             (#try.Success value)
             (#try.Success [state (list [meta (#.Nat value)])])

             (^multi (#try.Failure _)
                     [(:: <int> decode repr) (#try.Success value)])
             (#try.Success [state (list [meta (#.Int value)])])

             (^multi (#try.Failure _)
                     [(:: <rev> decode repr) (#try.Success value)])
             (#try.Success [state (list [meta (#.Rev value)])])

             (^multi (#try.Failure _)
                     [(:: <frac> decode repr) (#try.Success value)])
             (#try.Success [state (list [meta (#.Frac value)])])

             _
             (#try.Failure <error>))))

       _
       (#try.Failure <error>)))]

  [bin /nat.binary /int.binary /rev.binary /frac.binary
   "Invalid binary syntax."
   (encoding-doc "binary" (bin "11001001") (bin "11,00,10,01"))]
  [oct /nat.octal  /int.octal  /rev.octal  /frac.octal
   "Invalid octal syntax."
   (encoding-doc "octal" (oct "615243") (oct "615,243"))]
  [hex /nat.hex    /int.hex    /rev.hex    /frac.hex
   "Invalid hexadecimal syntax."
   (encoding-doc "hexadecimal" (hex "deadBEEF") (hex "dead,BEEF"))]
  )