aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/control/parser/tree.lux
blob: 50c8c8a0e6e36206e7f680d67d9a6737988efcfc (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
(.module:
  [lux #*
   [control
    ["." exception (#+ exception:)]]
   [data
    ["." error (#+ Error)]
    [tree (#+ Tree)
     ["." zipper (#+ Zipper)]]]]
  ["." //])

(type: #export (Parser t a)
  (//.Parser (Zipper t) a))

(def: #export (run-zipper zipper parser)
  (All [t a] (-> (Zipper t) (Parser t a) (Error a)))
  (case (//.run zipper parser)
    (#error.Success [zipper output])
    (#error.Success output)

    (#error.Failure error)
    (#error.Failure error)))

(def: #export (run tree parser)
  (All [t a] (-> (Tree t) (Parser t a) (Error a)))
  (run-zipper (zipper.zip tree) parser))

(def: #export value
  (All [t] (Parser t t))
  (function (_ zipper)
    (#error.Success [zipper (zipper.value zipper)])))

(exception: #export cannot-move-further)

(template [<name> <direction>]
  [(def: #export <name>
     (All [t] (Parser t []))
     (function (_ zipper)
       (let [next (<direction> zipper)]
         (if (is? zipper next)
           (exception.throw cannot-move-further [])
           (#error.Success [next []])))))]

  [up        zipper.up]
  [down      zipper.down]
  [left      zipper.left]
  [right     zipper.right]
  [root      zipper.root]
  [rightmost zipper.rightmost]
  [leftmost  zipper.leftmost]
  [next      zipper.next]
  [prev      zipper.prev]
  )