feat: add dynamic Map type (#1168)

* feat: add dynamic map prototype

* feat: feature parity for dynamic map

* docs: document dynamic map

* test: add dynamic map tests

* fix: defdynamics are handled in getBinderDescription

* test: i forgot to add dynamic tests, whoops
This commit is contained in:
Veit Heller 2021-02-11 09:12:58 +01:00 committed by GitHub
parent e05d55150d
commit dacc13560b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 445 additions and 24 deletions

View File

@ -3,6 +3,13 @@
(defmodule Dynamic
;; Functions for doing things at the REPL and during compile time.
(doc nil "is the value `nil`, i.e. the empty list.")
(defdynamic nil '())
(doc nil? "checks whether a value is nil, i.e. the empty list.")
(defndynamic nil? [value]
(= value nil))
(defndynamic inc [x]
(+ x 1))
@ -20,13 +27,16 @@
(set! m (- m b)))
(if (< a 0) (neg m) m)))
(defmodule List
(doc pairs "makes a list of pairs out of a list `l`. If the number of
elements is uneven, the trailing element will be discarded.")
(defndynamic pairs [l]
(if (< (length l) 2)
'()
(cons `(%(car l) %(cadr l)) (List.pairs (cddr l))))))
(doc imod "implements the modulo on integers, and is much faster than
[`mod](#mod).")
(defndynamic imod [x y]
(- x (* y (/ x y))))
(doc even? "checks whether the number `n` is even.")
(defndynamic even? [n] (= 0 (mod n 2)))
(doc odd? "checks whether the number `n` is odd.")
(defndynamic odd? [n] (= 1 (mod n 2)))
(defmodule Project
(doc no-echo "Turn off debug printing in the compiler.")

View File

@ -304,4 +304,38 @@ Example:
(let [r (walk-replace-finder pairs x)]
(if (empty? r) x (cadr r))))
form))
(defmodule List
(doc pairs "makes a list of pairs out of a list `l`. If the number of
elements is uneven, the trailing element will be discarded.")
(defndynamic pairs [l]
(if (< (length l) 2)
'()
(cons `(%(car l) %(cadr l)) (List.pairs (cddr l)))))
(doc nth "gets the nth element of the list `l`.")
(defndynamic nth [l n]
(cond
(empty? l) '()
(= n 0) (car l)
(List.nth (cdr l) (dec n))))
(doc update-nth "updates the nth element of the list `l` using the function `f`.")
(defndynamic update-nth [l n f]
(cond
(empty? l) '()
(= n 0) (cons (f (car l)) (cdr l))
(cons (car l) (List.update-nth (cdr l) (dec n) f))))
(doc set-nth "sets the nth element of the list `l` to the value `v`.")
(defndynamic set-nth [l n elem]
(List.update-nth l n (fn [_] elem)))
(doc find "finds the first element in the list `l` that matches `pred`.")
(defndynamic find [l pred]
(cond
(empty? l) '()
(pred (car l)) (car l)
(List.find (cdr l) pred)))
)
)

View File

@ -50,11 +50,13 @@
(defndynamic cddddr [pair] (cdr (cdr (cdr (cdr pair)))))
(defmodule List
; this should be defined using cond, but is defined before cond
(defndynamic in? [elem l]
(cond
(empty? l) false
(= elem (car l)) true
(in? elem (cdr l)))))
(if (empty? l)
false
(if (= elem (car l))
true
(List.in? elem (cdr l))))))
(defndynamic string? [s]
(= (dynamic-type s) 'string))

View File

@ -375,8 +375,8 @@
(doc from-array "Create a map from the array a containing key-value pairs.")
(defn from-array [a]
(let-do [m (create)]
(for [i 0 (Array.length a)]
(let [e (Array.unsafe-nth a i)
(for [i 0 (Array.length &a)]
(let [e (Array.unsafe-nth &a i)
k (Pair.a e)
v (Pair.b e)]
(put! &m k v)))
@ -397,7 +397,7 @@
(doc reverse "reverses they keys and values in a given map `m`.")
(defn reverse [m]
(from-array &(Array.copy-map &Pair.reverse &(to-array m))))
(from-array (Array.copy-map &Pair.reverse &(to-array m))))
)
(deftype (SetBucket a) [entries (Array a)])
@ -617,3 +617,182 @@
(String.append &res " }")))
(implements str Set.str)
)
; Dynamic maps:
(defmodule Dynamic
(doc n-times "make a list by executing `f` `n` times.")
(defndynamic n-times [n f]
(if (= n 0)
'()
(cons (f) (n-times (dec n) f))))
(defmodule Pair
(doc init "creates a dynamic pair, i.e. a list with two elements.")
(defndynamic init [k v] (list k v)))
(defmodule Map
(hidden dflt-len)
(defdynamic dflt-len 16)
(hidden min-load)
(defdynamic min-load 20)
(hidden max-load)
(defdynamic max-load 80)
(doc create "makes a dynamic map.")
(defndynamic create []
(n-times Map.dflt-len list))
(doc create "resizes a dynamic map to size `s`.")
(defndynamic resize [m s]
(let-do [n (n-times s list)]
(while-do (not (empty? m))
(map (fn [pair] (set! n (put n (car pair) (cadr pair)))) (car m))
(set! m (cdr m)))
n))
(doc grow "grows a dynamic map.")
(defndynamic grow [m] (resize m (* (length m) 2)))
(doc shrink "shrinks dynamic map.")
(defndynamic shrink [m]
(let [new-size (/ (length m) 2)]
(if (< new-size dflt-len)
m
(resize m new-size))))
(doc contains? "checks whether the dynamic map `m` contains the key `k`.")
(defndynamic contains? [m k]
(let [idx (Dynamic.imod (hash k) (length m))]
(List.in? k (map car (List.nth m idx)))))
(doc put "adds a value `v` under the key `k` into the map. If `k` already
exists in the map, it is updated.")
(defndynamic put [m k v]
(if (> (/ (* (Map.len m) 100) (length m)) Map.min-load)
(Map.put (grow m) k v)
(if (Map.contains? m k)
(Map.update m k (fn [_] v))
(let [idx (Dynamic.imod (hash k) (length m))]
(List.update-nth m idx (fn [l] (cons (list k v) l)))))))
(doc get-with-default "gets the value under the key `k`. If `k` doesnt
exist in the map, the default value is returned.")
(defndynamic get-with-default [m k default-value]
(if (Map.contains? m k)
(let [idx (Dynamic.imod (hash k) (length m))
l (List.nth m idx)]
(cadr (List.find l (fn [pair] (= (car pair) k)))))
default-value))
(doc get "gets the value under the key `k`. If `k` doesnt exist in the
map, `nil` is returned.")
(defndynamic get [m k]
(Map.get-with-default m k nil))
(doc update "updates the value under the key `k` using the function `f`. If
`k` doesnt exist in the map, it is returned unchanged.")
(defndynamic update [m k f]
(if (Map.contains? m k)
(let [idx (Dynamic.imod (hash k) (length m))]
(List.update-nth m idx
(curry
map
(fn [pair] (if (= (car pair) k) (list k (f (cadr pair))) pair)))))
m))
(doc update-with-default "updates the value under the key `k` using the
function `f`. If `k` doesnt exist in the map, it is set to `(f v)`.")
(defndynamic update-with-default [m k f v]
(if (Map.contains? m k)
(let [idx (Dynamic.imod (hash k) (length m))]
(List.update-nth m idx
(curry
map
(fn [pair] (if (= (car pair) k) (list k (f (cadr pair))) pair)))))
(Map.put m k (f v))))
(doc len "returns the length of the map `m`.")
(defndynamic len [m]
(reduce (fn [acc l] (+ acc (length l))) 0 m))
(doc empty? "checks whether the map `m` is empty.")
(defndynamic empty? [m]
(= (Map.len m) 0))
(doc keys "returns the key in the map `m`.")
(defndynamic keys [m]
(reduce (fn [acc l] (append acc (map car l))) '() m))
(doc vals "returns the values in the map `m`.")
(defndynamic vals [m]
(reduce (fn [acc l] (append acc (map cadr l))) '() m))
(doc reverse "reverses the key-value pairs in the map `m`.")
(defndynamic reverse [m]
(reduce
(fn [acc l] (reduce (fn [n p] (Map.put n (cadr p) (car p))) acc l))
(Map.create) m))
(defndynamic str [m]
(String.concat [
"{ "
(reduce
(fn [acc l]
(String.concat [
acc
(reduce
(fn [a pair] (String.concat [a (str (car pair)) " " (str (cadr pair)) " "]))
""
l)
]))
""
m)
"}"]))
(doc remove "removes the pair under the key `k` from the map `m`. If it
doesnt exist, the map is returned unchanged.")
(defndynamic remove [m k]
(if (> (/ (* (Map.len m) 100) (length m)) Map.min-load)
(Map.remove (shrink m) k)
(let [idx (imod (hash k) (length m))]
(reduce (fn [acc l] (cons (filter (fn [pair] (/= (car pair) k)) l) acc)) '() m))))
(doc all? "checks whether all key value pairs in `m` satisfy the predicate
`pred`. `pred` takes the pair `(k v)` as its sole argument.")
(defndynamic all? [pred m]
; TODO: using (curry all? pred) doesnt work here, i suppose its an env
; problem
(all? (fn [l] (all? pred l)) m))
(doc = "checks whether two maps `m1` and `m2` are equal.")
(defndynamic = [m1 m2]
(and (= (Map.len m1) (Map.len m2))
(Map.all? (fn [pair] (= (cadr pair) (Map.get m2 (car pair)))) m1)))
(doc map "maps the function `f` over all pairs in the map `m`. `f` takes
the pair `(k v)` as its sole argument and is expected to return a new value
under `v`.")
(defndynamic map [f m]
(map (fn [l] (map (fn [pair] (list (car pair) (f pair))) l)) m))
(doc kv-reduce "reduces the map `m` using the function `f` and the initial
value `init`. `f` takes the accumulator and the pair `(k v)` as its arguments
and is expected to return a new accumulator.")
(defndynamic kv-reduce [f init m]
(reduce (fn [acc l] (reduce f acc l)) init m))
(doc merge "merges to maps `m1` and `m2`. Values in `m1` are preferred on
collision.")
(defndynamic merge [m1 m2]
(Map.kv-reduce (fn [m pair] (Map.put m (car pair) (cadr pair))) m1 m2))
(doc from-array "creates a map from an array of key-value pairs `a`.")
(defndynamic from-array [a]
(reduce (fn [m pair] (Map.put m (car pair) (cadr pair))) (Map.create) a))
(doc to-array "creates an array of key-value pairs from the map `m`.")
(defndynamic to-array [m] (collect-into (reduce append '() m) array))
)
)

View File

@ -38,7 +38,6 @@
(defn assert-false [state x descr]
(assert-equal state false x descr))
(doc assert-ref-equal "Assert that x and y are equal by reference. Reference equality needs to be implemented for their type.")
(defn assert-ref-equal [state x y descr]
(handler state &x &y descr "value" =))
@ -59,6 +58,14 @@
(defn assert-error [state x descr]
(assert-true state (Result.error? x) descr))
(doc assert-dynamic-equal "Assert that the dynamic expressions `x` and `y` are equal.")
(defmacro assert-dynamic-equal [state x y descr]
`(Test.assert-equal %state true %(= (eval x) (eval y)) %descr))
(doc assert-dynamic-op "Assert that the dynamic expressions `x` and `y` are equal.")
(defmacro assert-dynamic-op [state x y descr op]
`(Test.assert-equal %state true %(op (eval x) (eval y)) %descr))
(doc reset "Reset test state.")
(defn reset [state]
(State.set-failed (State.set-passed state 0) 0))

View File

@ -311,7 +311,7 @@ eval ctx xobj@(XObj o info ty) preference resolver =
else evalError ctx ("`fn` requires all arguments to be unqualified symbols, but it got `" ++ pretty args ++ "`") (xobjInfo args)
Left err -> (ctx, Left err)
XObj (Closure (XObj (Lst [XObj (Fn _ _) _ _, XObj (Arr params) _ _, body]) _ _) (CCtx c)) _ _ : args ->
case checkArity "<closure>" params args of
case checkArity (pretty xobj) params args of
Left err -> pure (evalError ctx err (xobjInfo xobj))
Right () ->
do

View File

@ -323,6 +323,7 @@ getBinderDescription :: XObj -> String
getBinderDescription (XObj (Lst (XObj (Defn _) _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "defn"
getBinderDescription (XObj (Lst (XObj Def _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "def"
getBinderDescription (XObj (Lst (XObj Macro _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "macro"
getBinderDescription (XObj (Lst (XObj DefDynamic _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "defdynamic"
getBinderDescription (XObj (Lst (XObj Dynamic _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "dynamic"
getBinderDescription (XObj (Lst (XObj (Command _) _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "command"
getBinderDescription (XObj (Lst (XObj (Primitive _) _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "primitive"

View File

@ -565,9 +565,8 @@ dictionary = do
pairInit = XObj (Sym (SymPath ["Pair"] "init") (LookupGlobal CarpLand AFunction)) i Nothing
pairs = map (\(k, v) -> XObj (Lst [pairInit, k, v]) i Nothing) (pairwise objs')
arrayLiteral = XObj (Arr pairs) i Nothing
reffedArrayLiteral = XObj (Lst [XObj Ref i Nothing, arrayLiteral]) i Nothing
fromArraySymbol = XObj (Sym (SymPath ["Map"] "from-array") (LookupGlobal CarpLand AFunction)) i Nothing
fromArraySexp = XObj (Lst [fromArraySymbol, reffedArrayLiteral]) i Nothing
fromArraySexp = XObj (Lst [fromArraySymbol, arrayLiteral]) i Nothing
pure fromArraySexp
readerMacro :: String -> Obj -> Parsec.Parsec String ParseState XObj

189
test/dynamic_map.carp Normal file
View File

@ -0,0 +1,189 @@
(load "Test.carp")
(use Test)
(deftest test
(assert-dynamic-equal test
"2"
(Map.get (Map.put (Map.create) "1" "2") "1")
"basic put and get works"
)
(assert-dynamic-equal test
"3"
(Map.get (Map.put (Map.put (Map.create) "1" "2") "1" "3") "1")
"put, update and get"
)
(assert-dynamic-equal test
nil
(Map.get (Map.create) "1")
"get works with defaults"
)
(assert-dynamic-equal test
true
(Map.empty? (Map.update (Map.create) "x" inc))
"update works with empty map"
)
(assert-dynamic-equal test
2
(Map.get (Map.update {"x" 1} "x" inc) "x")
"update works"
)
(assert-dynamic-equal test
\x
(Map.get-with-default {1 \x} 1 \_)
"get-with-default works I"
)
(assert-dynamic-equal test
\_
(Map.get-with-default {1 \x} 2 \_)
"get-with-default works II"
)
(assert-dynamic-equal test
8
(Map.get (Map.update-with-default (Map.create) "x" inc 7) "x")
"update-with-default works with empty map"
)
(assert-dynamic-equal test
2
(Map.get (Map.update-with-default {"x" 1} "x" inc 7) "x")
"update-with-default works"
)
(assert-dynamic-equal test
1
(Map.len (Map.put (Map.create) "1" "2"))
"len works"
)
(assert-dynamic-equal test
0
(Map.len (Map.create))
"length works on empty map"
)
(assert-dynamic-equal test
false
(Map.contains? (Map.create) "1")
"contains? works on empty map"
)
(assert-dynamic-equal test
true
(Map.contains? (Map.put (Map.create) "1" "2") "1")
"contains? works"
)
(assert-dynamic-equal test
true
(Map.contains? (Map.put (Map.create) -7 "2") -7)
"contains? works with negative keys"
)
(assert-dynamic-equal test
false
(Map.contains? (Map.put (Map.create) 1 "2") -7)
"contains? works with negative keys"
)
(assert-dynamic-equal test
true
(Map.empty? (Map.create))
"empty? works on empty map"
)
(assert-dynamic-equal test
false
(Map.empty? (Map.put (Map.create) "1" "2"))
"empty? works"
)
(assert-dynamic-equal test
true
(Map.empty? (Map.remove (Map.put (Map.create) "1" "2") "1"))
"remove works"
)
(assert-dynamic-equal test
true
(Map.all? (fn [p] (or (even? (car p)) (cadr p)))
{1 true 2 false 4 false})
"Map.all? works I"
)
(assert-dynamic-equal test
false
(Map.all? (fn [p] (or (even? (car p)) (cadr p)))
{1 true 2 false 5 false})
"Map.all? works II"
)
(assert-dynamic-equal test
true
(Map.= {1 2 3 4} {1 2 3 4})
"Map.= works I"
)
(assert-dynamic-equal test
false
(Map.= {1 2 3 4} {1 2 3 5})
"Map.= works II"
)
(assert-dynamic-equal test
false
(Map.= {1 2 3 4} {1 2})
"Map.= works III"
)
(assert-dynamic-equal test
2
(Map.len (Map.from-array [(Pair.init 1 2)
(Pair.init 3 4)]))
"creating a map from an array works"
)
(assert-dynamic-equal test
"{ 1 2 }"
(Map.str (Map.from-array [(Pair.init 1 2)]))
"stringification works I"
)
(assert-dynamic-equal test
; TODO: should we escape strings?
"{ hi bye }"
(Map.str (Map.from-array [(Pair.init "hi" "bye")]))
"stringification works II"
)
(assert-dynamic-equal test
[(Pair.init 1 2)]
(Map.to-array (Map.put (Map.create) 1 2))
"Map.to-array works 1"
)
(assert-dynamic-equal test
2
(length (Map.to-array (Map.from-array [(Pair.init 1 2)
(Pair.init 3 4)])))
"Map.to-array works 2"
)
(assert-dynamic-equal test
"{ 1 12 3 34 }"
(Map.str (Map.map (fn [p] (+ (cadr p) (* 10 (car p)))) {1 2 3 4}))
"map works"
)
(assert-dynamic-equal test
641
(Map.kv-reduce (fn [sum p] (+ sum (+ (* 100 (car p)) (* 10 (cadr p)))))
1
{1 1 2 1 3 2})
"kv-reduce works"
)
(assert-dynamic-equal test
'(1 2 3)
(Map.keys {1 1 2 1 3 2})
"keys works"
)
(assert-dynamic-equal test
'(1 1 2)
(Map.vals {1 1 2 1 3 2})
"vals works"
)
(assert-dynamic-equal test
3
(Map.get {(Pair.init 1 2) 3} (Pair.init 1 2))
"Pairs work as keys"
)
(assert-dynamic-op test
{1 "hi" 2 "bye"}
(Map.reverse {"hi" 1 "bye" 2})
"reverse works"
Map.=
)
(assert-dynamic-op test
{1 "hi" 2 "bye" 3 "!"}
(Map.merge {1 "bye" 3 "!"} {2 "bye" 1 "hi"})
"merge works"
Map.=
)
)

View File

@ -151,18 +151,18 @@
)
(assert-equal test
2
(Map.length &(Map.from-array &[(Pair.init 1 2)
(Pair.init 3 4)]))
(Map.length &(Map.from-array [(Pair.init 1 2)
(Pair.init 3 4)]))
"creating a map from an array works"
)
(assert-equal test
"{ 1 2 }"
&(str &(Map.from-array &[(Pair.init 1 2)]))
&(str &(Map.from-array [(Pair.init 1 2)]))
"stringification works I"
)
(assert-equal test
"{ @\"hi\" @\"bye\" }"
&(str &(Map.from-array &[(Pair.init @"hi" @"bye")]))
&(str &(Map.from-array [(Pair.init @"hi" @"bye")]))
"stringification works II"
)
(assert-equal test
@ -172,8 +172,8 @@
)
(assert-equal test
2
(Array.length &(Map.to-array &(Map.from-array &[(Pair.init 1 2)
(Pair.init 3 4)])))
(Array.length &(Map.to-array &(Map.from-array [(Pair.init 1 2)
(Pair.init 3 4)])))
"Map.to-array works 2"
)
(assert-equal test