aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/data/collection/tree.lux
blob: d3222b959fca96dabc78583188701b4584692663 (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:
  [library
   [lux #*
    [abstract
     [functor (#+ Functor)]
     [equivalence (#+ Equivalence)]
     [mix (#+ Mix)]
     [monad (#+ do)]]
    [control
     ["<>" parser
      ["<.>" code (#+ Parser)]]]
    [data
     [collection
      ["." list ("#\." monad mix)]]]
    [macro
     [syntax (#+ syntax:)]
     ["." code]]]])

(type: .public (Tree a)
  (Record
   {#value a
    #children (List (Tree a))}))

(def: .public (flat tree)
  (All [a] (-> (Tree a) (List a)))
  (|> tree
      (value@ #children)
      (list\each flat)
      list\conjoint
      (#.Item (value@ #value tree))))

(def: .public (leaf value)
  (All [a] (-> a (Tree a)))
  {#value value
   #children (list)})

(def: .public (branch value children)
  (All [a] (-> a (List (Tree a)) (Tree a)))
  {#value value
   #children children})

(type: #rec Tree_Code
  [Code (List Tree_Code)])

(def: tree^
  (Parser Tree_Code)
  (|> (|>> <>.some
           <code>.record
           (<>.and <code>.any))
      <>.rec
      <>.some
      <code>.record
      (<>.else (list))
      (<>.and <code>.any)))

(syntax: .public (tree [root tree^])
  (in (list (` (~ (loop [[value children] root]
                    (` {#value (~ value)
                        #children (list (~+ (list\each recur children)))})))))))

(implementation: .public (equivalence super)
  (All [a] (-> (Equivalence a) (Equivalence (Tree a))))
  
  (def: (= tx ty)
    (and (\ super = (value@ #value tx) (value@ #value ty))
         (\ (list.equivalence (equivalence super)) = (value@ #children tx) (value@ #children ty)))))

(implementation: .public functor
  (Functor Tree)
  
  (def: (each f fa)
    {#value (f (value@ #value fa))
     #children (list\each (each f)
                          (value@ #children fa))}))

(implementation: .public mix
  (Mix Tree)
  
  (def: (mix f init tree)
    (list\mix (function (_ tree' init') (mix f init' tree'))
              (f (value@ #value tree)
                 init)
              (value@ #children tree))))