blob: 63a66d49b6603042bdab924c14ed551b4fc326ea (
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
|
## Copyright (c) Eduardo Julian. All rights reserved.
## The use and distribution terms for this software are covered by the
## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
## which can be found in the file epl-v10.html at the root of this distribution.
## By using this software in any fashion, you are agreeing to be bound by
## the terms of this license.
## You must not remove this notice, or any other, from this software.
(;import lux
(lux/data (eq #as E)))
## Signatures
(defsig #export (Dict d)
(: (All [k v]
(-> k (d k v) (Maybe v)))
get)
(: (All [k v]
(-> k v (d k v) (d k v)))
put)
(: (All [k v]
(-> k (d k v) (d k v)))
remove))
## Types
(deftype #export (PList k v)
(| (#PList (, (E;Eq k) (List (, k v))))))
## Constructors
(def #export (plist eq)
(All [k v]
(-> (E;Eq k) (PList k v)))
(#PList [eq #;Nil]))
## Utils
(def (pl-get eq k kvs)
(All [k v]
(-> (E;Eq k) k (List (, k v)) (Maybe v)))
(case kvs
#;Nil
#;None
(#;Cons [[k' v'] kvs'])
(if (:: eq (E;= k k'))
(#;Some v')
(pl-get eq k kvs'))))
(def (pl-put eq k v kvs)
(All [k v]
(-> (E;Eq k) k v (List (, k v)) (List (, k v))))
(case kvs
#;Nil
(#;Cons [[k v] kvs])
(#;Cons [[k' v'] kvs'])
(if (:: eq (E;= k k'))
(#;Cons [[k v] kvs'])
(#;Cons [[k' v'] (pl-put eq k v kvs')]))))
(def (pl-remove eq k kvs)
(All [k v]
(-> (E;Eq k) k (List (, k v)) (List (, k v))))
(case kvs
#;Nil
kvs
(#;Cons [[k' v'] kvs'])
(if (:: eq (E;= k k'))
kvs'
(#;Cons [[k' v'] (pl-remove eq k kvs')]))))
## Structs
(defstruct #export PList/Dict (Dict PList)
(def (get k plist)
(let [(#PList [eq kvs]) plist]
(pl-get eq k kvs)))
(def (put k v plist)
(let [(#PList [eq kvs]) plist]
(#PList [eq (pl-put eq k v kvs)])))
(def (remove k plist)
(let [(#PList [eq kvs]) plist]
(#PList [eq (pl-remove eq k kvs)]))))
|
