mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

more readable gensyms

Browse source 
* module/language/tree-il/peval.scm (peval):
* module/language/tree-il/primitives.scm (dynamic-wind): When you make a
  gensym that just has to be compared against other gensyms, it will be
  unique if the prefix doesn't end in something that can be interpreted
  as a number.  There's no reason to make that character something
  difficult like " ".  So change to use a dash in that case.

* module/ice-9/psyntax-pp.scm: Regenerate.  More readable now.
This commit is contained in:
Andy Wingo 2012-01-26 12:02:42 +01:00
parent f9685f4373
commit 6dc8c138f9
3 changed files with 5214 additions and 5989 deletions
Download patch file Download diff file Expand all files Collapse all files

11181
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because it is too large Load diff

10
module/language/tree-il/peval.scm
View file

@ -417,7 +417,7 @@ top-level bindings from ENV and return the resulting expression."
(define (fresh-gensyms vars) (define (fresh-gensyms vars)
(map (lambda (var) (map (lambda (var)
(let ((new (gensym (string-append (symbol->string (var-name var)) (let ((new (gensym (string-append (symbol->string (var-name var))
" ")))) "-"))))
(set! store (vhash-consq new var store)) (set! store (vhash-consq new var store))
new)) new))
vars)) vars))
@ -919,7 +919,7 @@ top-level bindings from ENV and return the resulting expression."
((not (constant-expression? pre)) ((not (constant-expression? pre))
(cond (cond
((not (constant-expression? post)) ((not (constant-expression? post))
(let ((pre-sym (gensym "pre ")) (post-sym (gensym "post "))) (let ((pre-sym (gensym "pre-")) (post-sym (gensym "post-")))
(record-new-temporary! 'pre pre-sym 1) (record-new-temporary! 'pre pre-sym 1)
(record-new-temporary! 'post post-sym 1) (record-new-temporary! 'post post-sym 1)
(make-let src '(pre post) (list pre-sym post-sym) (list pre post) (make-let src '(pre post) (list pre-sym post-sym) (list pre post)
@ -928,7 +928,7 @@ top-level bindings from ENV and return the resulting expression."
body body
(make-lexical-ref #f 'post post-sym))))) (make-lexical-ref #f 'post post-sym)))))
(else (else
(let ((pre-sym (gensym "pre "))) (let ((pre-sym (gensym "pre-")))
(record-new-temporary! 'pre pre-sym 1) (record-new-temporary! 'pre pre-sym 1)
(make-let src '(pre) (list pre-sym) (list pre) (make-let src '(pre) (list pre-sym) (list pre)
(make-dynwind src (make-dynwind src
@ -936,7 +936,7 @@ top-level bindings from ENV and return the resulting expression."
body body
post)))))) post))))))
((not (constant-expression? post)) ((not (constant-expression? post))
(let ((post-sym (gensym "post "))) (let ((post-sym (gensym "post-")))
(record-new-temporary! 'post post-sym 1) (record-new-temporary! 'post post-sym 1)
(make-let src '(post) (list post-sym) (list post) (make-let src '(post) (list post-sym) (list post)
(make-dynwind src (make-dynwind src
@ -1089,7 +1089,7 @@ top-level bindings from ENV and return the resulting expression."
(for-tail (for-tail
(make-sequence src (list k (make-const #f #f))))) (make-sequence src (list k (make-const #f #f)))))
(else (else
(let ((t (gensym "t ")) (let ((t (gensym "t-"))
(eq (if (eq? name 'memq) 'eq? 'eqv?))) (eq (if (eq? name 'memq) 'eq? 'eqv?)))
(record-new-temporary! 't t (length elts)) (record-new-temporary! 't t (length elts))
(for-tail (for-tail

12
module/language/tree-il/primitives.scm
View file

@ -1,6 +1,6 @@
;;; open-coding primitive procedures ;;; open-coding primitive procedures
;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. ;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -473,9 +473,9 @@
'dynamic-wind 'dynamic-wind
(case-lambda (case-lambda
((src pre thunk post) ((src pre thunk post)
(let ((PRE (gensym " pre")) (let ((PRE (gensym "pre-"))
(THUNK (gensym " thunk")) (THUNK (gensym "thunk-"))
(POST (gensym " post"))) (POST (gensym "post-")))
(make-let (make-let
src src
'(pre thunk post) '(pre thunk post)
@ -492,8 +492,8 @@
'@dynamic-wind '@dynamic-wind
(case-lambda (case-lambda
((src pre expr post) ((src pre expr post)
(let ((PRE (gensym " pre")) (let ((PRE (gensym "pre-"))
(POST (gensym " post"))) (POST (gensym "post-")))
(make-let (make-let
src src
'(pre post) '(pre post)