From 5188fb2251e02b32fd017dc7ba8cd6d0ce892c75 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 2 Aug 2020 23:25:56 +0200 Subject: Remove (util app). --- module/util/app.scm | 52 ---------------------------------------------------- 1 file changed, 52 deletions(-) delete mode 100644 module/util/app.scm (limited to 'module/util') diff --git a/module/util/app.scm b/module/util/app.scm deleted file mode 100644 index 65aed562..00000000 --- a/module/util/app.scm +++ /dev/null @@ -1,52 +0,0 @@ -(define-module (util app) - :use-module (util) - :use-module (srfi srfi-1) - :use-module (srfi srfi-9) - :use-module (srfi srfi-9 gnu) - :export (make-app current-app define-method getf setf) - ) - -(define-immutable-record-type - (make-app% ht) app? (ht get-ht)) - -(define-public (make-app) - (make-app% (make-hash-table))) - -(define current-app (make-parameter (make-app))) - -(define-syntax (define-method stx) - (with-syntax ((app (datum->syntax stx 'app))) - (syntax-case stx () - [(_ (name args ...) body ...) - - (let* ((pre post (break (lambda (s) (eqv? key: (syntax->datum s))) - #'(args ...)))) - #`(define*-public (name #,@pre #,@(if (null? post) '(key:) post) - (app (current-app))) - (parameterize ((current-app app)) - body ...)))]))) - - -(define-method (getf field) - (aif (hashq-ref (get-ht app) field) - (force it) - (error "No field" field))) - -(define-syntax setf% - (syntax-rules () - [(_ app field value) - (hashq-set! (get-ht (current-app)) field (delay value))])) - -;; TODO setting a field should invalidate the cache of all dependant -;; fields. Among other things allowing a full calendar reload by running -;; (setf 'calendars (load-calendars ...)) -(define-syntax setf - (syntax-rules () - ;; special case to use current app) - [(_ key value) - (setf (current-app) key value)] - - [(_ app) app] - [(_ app key value rest ...) - (begin (setf% app key value) - (setf app rest ...))])) -- cgit v1.2.3