From d5da7661c8710fa8dad66ca93b021c2e5158390a Mon Sep 17 00:00:00 2001 From: BT Templeton Date: Thu, 7 Jul 2011 19:30:38 -0400 Subject: [PATCH] use srfi-9 for elisp bindings records * module/language/elisp/bindings.scm: Use `(srfi srfi-9)'. (bindings-type): Remove low-level record type definition and replace with... (bindings): ...this, an SRFI-9 record type. All uses changed. (mark-global-needed!): Rename to... (mark-global!): ...this. All callers changed. (map-globals-needed): Rename to... (map-globals): ...this. All callers changed. --- module/language/elisp/bindings.scm | 69 +++++++++++------------ module/language/elisp/compile-tree-il.scm | 28 ++++----- 2 files changed, 47 insertions(+), 50 deletions(-) diff --git a/module/language/elisp/bindings.scm b/module/language/elisp/bindings.scm index 6ff56fdcd..04ab0219f 100644 --- a/module/language/elisp/bindings.scm +++ b/module/language/elisp/bindings.scm @@ -19,9 +19,10 @@ ;;; Code: (define-module (language elisp bindings) + #:use-module (srfi srfi-9) #:export (make-bindings - mark-global-needed! - map-globals-needed + mark-global! + map-globals with-lexical-bindings with-dynamic-bindings get-lexical-binding)) @@ -41,59 +42,56 @@ ;;; Record type used to hold the data necessary. -(define bindings-type - (make-record-type 'bindings '(needed-globals lexical-bindings))) +(define-record-type bindings + (%make-bindings globals lexical-bindings) + bindings? + (globals globals set-globals!) + (lexical-bindings lexical-bindings set-lexical-bindings!)) ;;; Construct an 'empty' instance of the bindings data structure to be ;;; used at the start of a fresh compilation. (define (make-bindings) - ((record-constructor bindings-type) '() (make-hash-table))) + (%make-bindings '() (make-hash-table))) ;;; Mark that a given symbol is needed as global in the specified ;;; slot-module. -(define (mark-global-needed! bindings sym module) - (let* ((old-needed ((record-accessor bindings-type 'needed-globals) - bindings)) - (old-in-module (or (assoc-ref old-needed module) '())) +(define (mark-global! bindings sym module) + (let* ((old-globals (globals bindings)) + (old-in-module (or (assoc-ref old-globals module) '())) (new-in-module (if (memq sym old-in-module) old-in-module (cons sym old-in-module))) - (new-needed (assoc-set! old-needed module new-in-module))) - ((record-modifier bindings-type 'needed-globals) - bindings - new-needed))) + (new-globals (assoc-set! old-globals module new-in-module))) + (set-globals! bindings new-globals))) ;;; Cycle through all globals needed in order to generate the code for ;;; their creation or some other analysis. -(define (map-globals-needed bindings proc) - (let ((needed ((record-accessor bindings-type 'needed-globals) - bindings))) - (let iterate-modules ((mod-tail needed) - (mod-result '())) - (if (null? mod-tail) - mod-result - (iterate-modules - (cdr mod-tail) - (let* ((aentry (car mod-tail)) - (module (car aentry)) - (symbols (cdr aentry))) - (let iterate-symbols ((sym-tail symbols) - (sym-result mod-result)) - (if (null? sym-tail) - sym-result - (iterate-symbols (cdr sym-tail) - (cons (proc module (car sym-tail)) - sym-result)))))))))) +(define (map-globals bindings proc) + (let iterate-modules ((mod-tail (globals bindings)) + (mod-result '())) + (if (null? mod-tail) + mod-result + (iterate-modules + (cdr mod-tail) + (let* ((aentry (car mod-tail)) + (module (car aentry)) + (symbols (cdr aentry))) + (let iterate-symbols ((sym-tail symbols) + (sym-result mod-result)) + (if (null? sym-tail) + sym-result + (iterate-symbols (cdr sym-tail) + (cons (proc module (car sym-tail)) + sym-result))))))))) ;;; Get the current lexical binding (gensym it should refer to in the ;;; current scope) for a symbol or #f if it is dynamically bound. (define (get-lexical-binding bindings sym) - (let* ((lex ((record-accessor bindings-type 'lexical-bindings) - bindings)) + (let* ((lex (lexical-bindings bindings)) (slot (hash-ref lex sym #f))) (if slot (fluid-ref slot) @@ -106,8 +104,7 @@ (if (or (not (list? syms)) (not (and-map symbol? syms))) (error "can't bind non-symbols" syms)) - (let ((lex ((record-accessor bindings-type 'lexical-bindings) - bindings))) + (let ((lex (lexical-bindings bindings))) (for-each (lambda (sym) (if (not (hash-ref lex sym)) (hash-set! lex sym (make-fluid)))) diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index 36823f320..d259083b6 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -133,9 +133,9 @@ (define (ensuring-globals loc bindings body) (make-sequence loc - `(,@(map-globals-needed (fluid-ref bindings) - (lambda (mod sym) - (generate-ensure-global loc sym mod))) + `(,@(map-globals (fluid-ref bindings) + (lambda (mod sym) + (generate-ensure-global loc sym mod))) ,body))) ;;; Build a construct that establishes dynamic bindings for certain @@ -185,7 +185,7 @@ (lambda () (make-module-ref loc module sym #t)) (lambda (lexical) (make-lexical-ref loc lexical lexical)) (lambda () - (mark-global-needed! (fluid-ref bindings-data) sym module) + (mark-global! (fluid-ref bindings-data) sym module) (call-primitive loc 'fluid-ref (make-module-ref loc module sym #t))))) @@ -206,7 +206,7 @@ (list (make-const loc module) (make-const loc sym) value))) (lambda (lexical) (make-lexical-set loc lexical lexical value)) (lambda () - (mark-global-needed! (fluid-ref bindings-data) sym module) + (mark-global! (fluid-ref bindings-data) sym module) (call-primitive loc 'fluid-set! (make-module-ref loc module sym #t) @@ -276,9 +276,9 @@ (lambda () (split-let-bindings bind module)) (lambda (lexical dynamic) (for-each (lambda (sym) - (mark-global-needed! (fluid-ref bindings-data) - sym - module)) + (mark-global! (fluid-ref bindings-data) + sym + module)) (map car dynamic)) (let ((make-values (lambda (for) (map (lambda (el) (compile-expr (cdr el))) @@ -321,9 +321,9 @@ (begin (for-each (lambda (sym) (if (not (bind-lexically? sym module)) - (mark-global-needed! (fluid-ref bindings-data) - sym - module))) + (mark-global! (fluid-ref bindings-data) + sym + module))) (map car bind)) (let iterate ((tail bind)) (if (null? tail) @@ -470,9 +470,9 @@ optional-dyn-pairs rest-dyn-pairs))) (for-each (lambda (sym) - (mark-global-needed! (fluid-ref bindings-data) - sym - value-slot)) + (mark-global! (fluid-ref bindings-data) + sym + value-slot)) dynamic) (with-dynamic-bindings (fluid-ref bindings-data)