Skip to content

Instantly share code, notes, and snippets.

@AutumnalAntlers
Created October 6, 2022 05:58
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save AutumnalAntlers/569e34c6bfe62ed39f1a7da81e13d47b to your computer and use it in GitHub Desktop.
Save AutumnalAntlers/569e34c6bfe62ed39f1a7da81e13d47b to your computer and use it in GitHub Desktop.
`with-refs` Macro
(define-module (antlers utils with-refs)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:export (with-refs))
;;; Commentary:
;;
;; The first draft looked like this, which, to be honest, I kind of like for it's simplicity.
;; Ditched it because of the repetitive match-lambda-lists and hash-set/-ref
;; calls, but... it feels so short readable, even by comparison to where I ended up.
;;
;; (define (with-refs* clauses thunk)
;; (define bindings (make-hash-table))
;; (define register-clause-bindings
;; (match-lambda (`((,module-ref ,var-ref) ,val)
;; (hash-set! bindings (list module-ref var-ref 'module) (gensym))
;; (hash-set! bindings (list module-ref var-ref 'internal-val) (gensym))
;; (hash-set! bindings (list module-ref var-ref 'external-val) (gensym)))))
;; (define clause->bindings
;; (match-lambda (`((,module-ref ,var-ref) ,val)
;; `((,(hash-ref bindings (list module-ref var-ref 'module)) (resolve-module ,module-ref))
;; (,(hash-ref bindings (list module-ref var-ref 'internal-val)) ,val)
;; (,(hash-ref bindings (list module-ref var-ref 'external-val)) #f)))))
;; (define clause->setter
;; (match-lambda (`((,module-ref ,var-ref) ,val)
;; `((set! ,(hash-ref bindings (list module-ref var-ref 'external-val))
;; (module-ref ,(hash-ref bindings (list module-ref var-ref 'module)) ,var-ref))
;; (module-define! ,(hash-ref bindings (list module-ref var-ref 'module))
;; (quote ,var-ref)
;; ,(hash-ref bindings (list module-ref var-ref 'internal-val)))))))
;; (define clause->resetter
;; (match-lambda (`((,module-ref ,var-ref) ,val)
;; `((set! ,(hash-ref bindings (list module-ref var-ref 'internal-val))
;; (module-ref ,(hash-ref bindings (list module-ref var-ref 'module)) ,var-ref))
;; (module-define! ,(hash-ref bindings (list module-ref var-ref 'module))
;; (quote ,var-ref)
;; ,(hash-ref bindings (list module-ref var-ref 'external-val)))))))
;; (map register-clause-bindings clauses)
;; `(let ,@(map clause->bindings clauses)
;; (dynamic-wind
;; (lambda () ,@(append-map clause->setter clauses))
;; ,thunk
;; (lambda () ,@(append-map clause->resetter clauses)))))
;;
;;; Code:
(define *unset-gensym* (gensym))
(define-record-type <clause>
(make-clause module-ref var-ref initial-val
module-gensym internal-val-gensym external-val-gensym)
clause?
(module-ref clause-module-ref)
(var-ref clause-var-ref)
(initial-val clause-initial-val)
(module-gensym clause-module-gensym)
(internal-val-gensym clause-internal-val-gensym)
(external-val-gensym clause-external-val-gensym))
(define (clause->bindings clause)
`((,(clause-module-gensym clause) (resolve-module ,(clause-module-ref clause)))
(,(clause-internal-val-gensym clause) ,(clause-initial-val clause))
(,(clause-external-val-gensym clause) #f)))
(define (clause->setter clause)
`((set! ,(clause-external-val-gensym clause)
(if (module-bound? ,(clause-module-gensym clause) ,(clause-var-ref clause))
(module-ref ,(clause-module-gensym clause) ,(clause-var-ref clause))
,*unset-gensym*))
(module-define! ,(clause-module-gensym clause)
,(clause-var-ref clause)
,(clause-internal-val-gensym clause))))
(define (clause->resetter clause)
`((cond ((equal? ,(clause-external-val-gensym clause) ,*unset-gensym*)
(variable-unset! (module-variable ,(clause-module-gensym clause) ,(clause-var-ref clause))))
(else (set! ,(clause-internal-val-gensym clause)
(module-ref ,(clause-module-gensym clause) ,(clause-var-ref clause)))
(module-define! ,(clause-module-gensym clause)
,(clause-var-ref clause)
,(clause-external-val-gensym clause))))))
(define (with-refs* clauses* thunk)
(define clauses '())
(define register-clause
(match-lambda (`((,module-ref ,var-ref) ,val)
(set! clauses (cons (make-clause module-ref var-ref val (gensym) (gensym) (gensym))
clauses)))))
(map register-clause clauses*)
`(let ,(cons `(,*unset-gensym* (gensym))
(append-map clause->bindings clauses))
(dynamic-wind
(lambda () ,@(append-map clause->setter clauses))
,thunk
(lambda () ,@(append-map clause->resetter clauses)))))
(defmacro with-refs (clauses expr . rest)
(with-refs* clauses `(lambda () ,@(cons expr rest))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment