diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-05 16:56:25 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-05 16:56:25 +0100 |
commit | 03fa9a546c27f95d3b039ded5408917024761250 (patch) | |
tree | fbc6a23507b22a6a226c3bb1d7c5bb58e2531c8b /util.scm | |
parent | Add attr as generalized setter for vcomponent attributes. (diff) | |
download | calp-03fa9a546c27f95d3b039ded5408917024761250.tar.gz calp-03fa9a546c27f95d3b039ded5408917024761250.tar.xz |
Add util module.
Diffstat (limited to '')
-rw-r--r-- | util.scm | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/util.scm b/util.scm new file mode 100644 index 00000000..bc889386 --- /dev/null +++ b/util.scm @@ -0,0 +1,45 @@ +(define-module (util) + #:use-module (srfi srfi-1) + #:export (destructure-lambda let-multi fold-lists catch-let) + ) + +(define-public upstring->symbol (compose string->symbol string-upcase)) + +(define-public symbol-upcase (compose string->symbol string-upcase symbol->string)) + +(define-public symbol-downcase (compose string->symbol string-downcase symbol->string)) + +(define-syntax destructure-lambda + (syntax-rules () + ((_ expr-list body ...) + (lambda (expr) + (apply (lambda expr-list body ...) expr))))) + +#; +(map (destructure-lambda (a b) (+ a b)) + (map list (iota 10) (iota 10 10))) + +(define-syntax let-multi + (syntax-rules () + ((let-m identifiers lst body ...) + (apply (lambda identifiers body ...) + lst)))) + +(define-syntax fold-lists + (syntax-rules (lambda) + ((_ (lambda ((list-part ...) object) body ...) seed list) + (fold (lambda (kv object) + (let-multi (list-part ...) kv + body ...)) + seed + list)))) + +(define-syntax catch-let + (syntax-rules () + ((_ thunk ((type handler) ...)) + (catch #t thunk + (lambda (err . args) + (case err + ((type) (apply handler err args)) ... + (else (format #t "Unhandled error type ~a, rethrowing ~%" err) + (apply throw err args)))))))) |