From f492a5278b885d8838c5537c88b95a02ca3671df Mon Sep 17 00:00:00 2001 From: Linus Date: Sat, 2 Jan 2021 12:03:03 +0100 Subject: [PATCH] Added hashing, hashqing hashving och in-hash. --- documentation/doc.xml | 62 +++++++++++++++++++++++++------------------ goof.scm | 2 ++ goof/iterators.scm | 44 ++++++++++++++++++++++++++++++ 3 files changed, 82 insertions(+), 26 deletions(-) diff --git a/documentation/doc.xml b/documentation/doc.xml index 21b7039..36a1af7 100644 --- a/documentation/doc.xml +++ b/documentation/doc.xml @@ -197,10 +197,10 @@
-
(:for identifier (in start [update [stop]]))
+
(:for binding (in start [update [stop]]))

- Binds a loop variable to identifier. It's first value is start. It is updated by the update expression, or is left unchanged if no such expression is present. If a stop expression is provided, it will be evaluated before each loop body. If the stop expression returns true, the iteration will be considered exhausted. + Binds a loop variable to binding. It's first value is start. It is updated by the update expression, or is left unchanged if no such expression is present. If a stop expression is provided, it will be evaluated before each loop body. If the stop expression returns true, the iteration will be considered exhausted. (loop ((:for a (in 0 b)) (:for b (in 1 (+ a b) (> b 20)))) @@ -210,40 +210,50 @@

-
(:for identifier (up-from start [(to bound)] [(by step)])
-
(:for identifier (up-from start [bound [by]]))
-
Binds identifier to the number start up to bound (exclusive!) by step. If no bound is given, it will yield values indefinitely. The second shorter form will not allow unbounded iteratiom.
+
(:for binding (up-from start [(to bound)] [(by step)])
+
(:for binding (up-from start [bound [by]]))
+
Binds binding to the number start up to bound (exclusive!) by step. If no bound is given, it will yield values indefinitely. The second shorter form will not allow unbounded iteratiom.
-
(:for identifier (down-from start [(to bound)] [(by step)])
-
(:for identifier (down-from start [bound [by]]))
-
Binds identifier to the number start down to bound (inclusive!) by step. If no bound is given, it will yield values indefinitely. The second shorter form will not allow unbounded iteratiom.
+
(:for binding (down-from start [(to bound)] [(by step)])
+
(:for binding (down-from start [bound [by]]))
+
Binds binding to the number (- start 1) down to bound (inclusive!) by step. If no bound is given, it will yield values indefinitely. The second shorter form will not allow unbounded iteratiom.
-
(:for identifier [pair] (in-list expr [by])
-
Binds identifier to the car of the loop variable pair. pair is advanced by applying the procedure by to it (defaulting to cdr). The iteration stops when pair is the empty list.
+
(:for binding [pair] (in-list expr [by])
+
Binds binding to the car of the loop variable pair. pair is advanced by applying the procedure by to it (defaulting to cdr). The iteration stops when pair is the empty list.
-
(:for identifier [pairs] (in-lists expr [by])
-
Works the same as in-list, but expr must evaluate to a list of lists. identifier is bound to the car of those lists, and they are advanced by by, defaulting to cdr.
+
(:for binding [pairs] (in-lists expr [by])
+
Works the same as in-list, but expr must evaluate to a list of lists. binding is bound to the car of those lists, and they are advanced by by, defaulting to cdr.
-
(:for identifier [index] (in-vector expr [low [high]]))
-
Binds identifier to all elements in the vector produced by expr in order from low to high. low defaults to 0 and high defaults to the last index of the vector.
+
(:for binding [index] (in-vector expr [low [high]]))
+
Binds binding to all elements in the vector produced by expr in order from low to high. low defaults to 0 and high defaults to the last index of the vector.
-
(:for identifier [index] (in-reverse-vector expr [high [low]]))
-
Binds identifier to all elements in the vector produced by expr in reverse order from high to low. high defaults to the last element of the vector and low defaults to 0.
+
(:for binding [index] (in-reverse-vector expr [high [low]]))
+
Binds binding to all elements in the vector produced by expr in reverse order from high to low. high defaults to the last element of the vector and low defaults to 0.
-
(:for identifier [index] (in-string expr [low [high]]))
-
Binds identifier to all elements in the string produced by expr in order from low to high. low defaults to 0 and high defaults to the last index of the string.
+
(:for binding [index] (in-string expr [low [high]]))
+
Binds binding to all elements in the string produced by expr in order from low to high. low defaults to 0 and high defaults to the last index of the string.
-
(:for identifier [index] (in-reverse-string expr [high [low]]))
-
Binds identifier to all elements in the vector produced by expr in reverse order from high to low. high defaults to the last element of the vector and low defaults to 0.
+
(:for binding [index] (in-reverse-string expr [high [low]]))
+
Binds binding to all elements in the vector produced by expr in reverse order from high to low. high defaults to the last element of the vector and low defaults to 0.
-
(:for identifier (in-port port [reader [eof?]]))
-
Binds identifier to the result of calling reader on port. Iteration stops when (eof? identifier) returns true.
+
(:for binding (in-port port [reader [eof?]]))
+
Binds binding to the result of calling reader on port. Iteration stops when (eof? binding) returns true.
-
(:for identifier (in-file path [reader [eof?]]))
-
Opens the file located at path (which is a string) and binds identifier to the result of calling reader on the opened port. Iteration stops when (eof? identifier) returns true.
+
(:for binding (in-file path [reader [eof?]]))
+
Opens the file located at path (which is a string) and binds binding to the result of calling reader on the opened port. Iteration stops when (eof? binding) returns true.
+ +
(:for binding (in-generator gen))
+
Binds binding to the result of calling the SRFI-158-compatible generator gen. Iteration stops when gen returns the end-of-file object.
+ +
(:for binding (in-hash hash))
+
Binds binding to the (key . value) pairs of the hash-table hash. May, as all body-binding variables, be pattern-matched: + + + (loop/list (((_ . val) (in-hash hash-table))) + val) + +
-
(:for identifier (in-generator gen))
-
Binds identifier to the result of calling the SRFI-158-compatible generator gen. Iteration stops when gen returns the end-of-file object.
diff --git a/goof.scm b/goof.scm index 403dfa7..6bf608e 100644 --- a/goof.scm +++ b/goof.scm @@ -58,6 +58,7 @@ in-vector in-reverse-vector in-string in-reverse-string + in-hash in-port in-file @@ -72,6 +73,7 @@ appending-reverse summing multiplying + hashing in-cycle in-indexed diff --git a/goof/iterators.scm b/goof/iterators.scm index 2d76842..84e3a32 100644 --- a/goof/iterators.scm +++ b/goof/iterators.scm @@ -248,6 +248,20 @@ ((down-from ((var) (start limit)) next . rest) (down-from ((var) (start limit 1)) next . rest)))) + +(define-syntax in-hash + (syntax-rules () + ((_ ((bindings) (expr)) n . rest) + (n + () + () + ((cursor (hash-map->list cons expr) (cdr cursor))) + ((not (pair? cursor))) + ((bindings (car cursor))) + () + . rest)))) + + (define-syntax accumulating (syntax-rules (initial if :acc) ((accumulating :acc (kons final init) ((var) . x) next . rest) @@ -317,6 +331,36 @@ ((multiplying :acc args next . rest) (accumulating :acc (* (lambda (x) x) 1) args next . rest)))) +(define-syntax define-hashing + (syntax-rules () + ((_ name default-make setter) + (define-syntax name + (syntax-rules (:acc if initial) + ((_ :acc ((var) (key value)) n . rest) + (name :acc ((var) (key value (if #t) (initial defualt-make))) n . rest)) + ;; either init or if + ((_ :acc ((var) (key value (if guard))) n . rest) + (name :acc ((var) (key value (if guard) (initial default-make))) n . rest)) + ((_ :acc ((var) (key value (initial init))) n . rest) + (name :acc ((var) (key value (if #t) (initial init))) n . rest)) + ;; both init and if + ((_ :acc ((var) (key value (initial init) (if guard))) n . rest) + (name ((var) (key value (if guard) (initial init))) n . rest)) + ((_ :acc ((var) (key value (if guard) (initial init))) n . rest) + (n + ((hash init)) + ((dummy (if #f #f) (if guard (setter hash key value) (if #f #f)))) + () + () + () + ((var hash)) + . rest))))))) + +(define-hashing hashing (make-hash-table) hash-set!) +(define-hashing hashving (make-hash-table) hashv-set!) +(define-hashing hashqing (make-hash-table) hashq-set!) + + ;;; Here starts generator clauses.