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))))
|