1
0
mirror of https://github.com/janet-lang/janet synced 2024-11-18 06:34:48 +00:00

Merge pull request #10 from Gavlooth/master

Fix if-let when-let and add put-in (assoc-in)
This commit is contained in:
Calvin Rose 2018-03-25 14:47:14 -04:00 committed by GitHub
commit b70d6cad1b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 33 additions and 7 deletions

22
examples/utils.dst Normal file
View File

@ -0,0 +1,22 @@
(defn put-in [coll keys val]
(defn assoc [the-coll n]
(if-let [current-key (get keys n)
current-val (get the-coll current-key)]
(put the-coll current-key (assoc current-val (inc n)))
val))
(assoc coll 0))
(defn update-in [coll keys an-fn]
(def new-keys (array-slice coll 0 -2) )
(def last-key (get (array-slice coll -1 -2) 0))
(defn assoc [the-coll n]
(if-let [current-key (get keys n)
current-val (get the-coll current-key)]
(put the-coll current-key (assoc current-val (inc n)))
( update the-coll last-key an-fn )))
(assoc coll new-keys 0))
;; (defn update-in-test [ ] (update-in @{:a "x" :b {:y {"pipa" 3}}} [:b :y "pipa"] type))

View File

@ -367,13 +367,15 @@ If no match is found, returns nil"
(tuple 'when (tuple not condition) exp-1))
(defmacro if-let
"Takes the first one or two forms in a vector and if true binds
"Takes the first one or two forms in a vector and if both are true binds
all the forms with let and evaluates the first expression else
evaluates the second"
[bindings then else]
(def head (ast-unwrap1 bindings))
(tuple 'let head
(tuple 'if (and (get head 1) (if (get head 2) (get head 3) true))
(tuple 'let bindings
(tuple 'if (tuple 'and (tuple 'get bindings 1)
(tuple 'if
(tuple '> (tuple 'length bindings) 2)
(tuple 'get bindings 3) 'true))
then
else)))
@ -381,11 +383,13 @@ If no match is found, returns nil"
"Takes the first one or two forms in vector and if true binds
all the forms with let and evaluates the body"
[bindings & body]
(def head (ast-unwrap1 bindings))
(tuple 'let head
(tuple 'let bindings
(tuple
'when
(and (get head 1) (if (get head 2) (get head 3) true))
(tuple 'and (tuple 'get bindings 1)
(tuple 'if
(tuple '> (tuple 'length bindings) 2)
(tuple 'get bindings 3) 'true))
(apply1 tuple (array-concat ['do] (ast-unwrap1 body))))))
(defn comp