- Timestamp:
- 05/28/20 17:08:14 (8 months ago)
- Location:
- release/5/procedural-macros
- Files:
-
- 2 edited
- 4 copied
Legend:
- Unmodified
- Added
- Removed
-
release/5/procedural-macros/tags/3.0.1/procedural-macros.egg
r38670 r38710 5 5 (dependencies bindings) 6 6 (author "Juergen Lorenz") 7 (version "3.0 ")7 (version "3.0.1") 8 8 (components 9 9 (extension procedural-macros -
release/5/procedural-macros/tags/3.0.1/procedural-macros.scm
r38670 r38710 416 416 ;;; The code is more or less due to 417 417 ;;; P. Seibel, Practical Common Lisp, p. 102 418 (define-syntax once-only 419 (er-macro-transformer 420 (lambda (form rename compare?) 421 (let ((syms (cadr form)) 422 (xpr (caddr form)) 423 (xprs (cdddr form))) 424 (let ((%syms (map rename syms)) 425 (%let (rename 'let)) 426 (%list (rename 'list))) 427 `(,%let ,(map (lambda (g) `(,g ,(rename `',g))) %syms) 428 `(,',%let ,(,%list ,@(map (lambda (g n) ``(,,g ,,n)) 429 %syms syms)) 430 ,(,%let ,(map (lambda (n g) `(,n ,g)) 431 syms %syms) 432 ,xpr ,@xprs)))))))) 418 (define-macro (once-only (x . xs) xpr . xprs) 419 (let ((syms (cons x xs)) (body (cons xpr xprs))) 420 (let ((gensyms (map (lambda (n) (gensym)) syms))) 421 `(let ,(map (lambda (g) `(,g ',(gensym))) gensyms) 422 `(let ,(list ,@(map (lambda (g n) ``(,,g ,,n)) 423 gensyms syms)) 424 ,(let ,(map (lambda (n g) `(,n ,g)) 425 syms gensyms) 426 ,@body)))))) 433 427 434 428 ;;; (with-renamed-symbols (renamer . %syms) xpr . xprs) 435 429 ;;; --------------------------------------------------- 436 (define-syntax with-renamed-symbols 437 (er-macro-transformer 438 (lambda (form rename compare?) 439 (let ((syms (cadr form)) 440 (xpr (caddr form)) 441 (xprs (cdddr form)) 442 ) 443 (let ((renamer (car syms)) 444 (%syms (cdr syms)) 445 (%let (rename 'let)) 446 ) 447 `(,%let ,(map (lambda (s) 448 ;`(,(symbol-append prefix s) (,renamer ',s))) 449 `(,s (,renamer 450 ',(string->symbol 451 (substring (symbol->string s) 1))))) 452 %syms) 453 ,xpr ,@xprs)))))) 430 (define-er-macro (with-renamed-symbols (renamer . syms) xpr . xprs) 431 % 432 `(,%let ,(map (lambda (s) 433 `(,s (,renamer 434 ',(string->symbol 435 (substring (symbol->string s) 1))))) 436 syms) 437 ,xpr ,@xprs)) 454 438 455 439 ;;; (with-gensyms (name ....) xpr ....) 456 440 ;;; ----------------------------------- 457 441 ;;; binds name ... to (gensym 'name) ... in body xpr ... 458 (define-syntax with-gensyms 459 (ir-macro-transformer 460 (lambda (form inject compare?) 461 `(let ,(map (lambda (n) `(,n (gensym ',n))) (cadr form)) 462 ,@(cddr form))))) 442 (define-macro (with-gensyms (name . names) xpr . xprs) 443 (let ((names (cons name names)) (body (cons xpr xprs))) 444 `(let ,(map (lambda (n) `(,n (gensym ',n))) names) 445 ,@body))) 463 446 464 447 ;;; (procedural-macros sym ..) -
release/5/procedural-macros/trunk/procedural-macros.egg
r38670 r38710 5 5 (dependencies bindings) 6 6 (author "Juergen Lorenz") 7 (version "3.0 ")7 (version "3.0.1") 8 8 (components 9 9 (extension procedural-macros -
release/5/procedural-macros/trunk/procedural-macros.scm
r38670 r38710 416 416 ;;; The code is more or less due to 417 417 ;;; P. Seibel, Practical Common Lisp, p. 102 418 (define-syntax once-only 419 (er-macro-transformer 420 (lambda (form rename compare?) 421 (let ((syms (cadr form)) 422 (xpr (caddr form)) 423 (xprs (cdddr form))) 424 (let ((%syms (map rename syms)) 425 (%let (rename 'let)) 426 (%list (rename 'list))) 427 `(,%let ,(map (lambda (g) `(,g ,(rename `',g))) %syms) 428 `(,',%let ,(,%list ,@(map (lambda (g n) ``(,,g ,,n)) 429 %syms syms)) 430 ,(,%let ,(map (lambda (n g) `(,n ,g)) 431 syms %syms) 432 ,xpr ,@xprs)))))))) 418 (define-macro (once-only (x . xs) xpr . xprs) 419 (let ((syms (cons x xs)) (body (cons xpr xprs))) 420 (let ((gensyms (map (lambda (n) (gensym)) syms))) 421 `(let ,(map (lambda (g) `(,g ',(gensym))) gensyms) 422 `(let ,(list ,@(map (lambda (g n) ``(,,g ,,n)) 423 gensyms syms)) 424 ,(let ,(map (lambda (n g) `(,n ,g)) 425 syms gensyms) 426 ,@body)))))) 433 427 434 428 ;;; (with-renamed-symbols (renamer . %syms) xpr . xprs) 435 429 ;;; --------------------------------------------------- 436 (define-syntax with-renamed-symbols 437 (er-macro-transformer 438 (lambda (form rename compare?) 439 (let ((syms (cadr form)) 440 (xpr (caddr form)) 441 (xprs (cdddr form)) 442 ) 443 (let ((renamer (car syms)) 444 (%syms (cdr syms)) 445 (%let (rename 'let)) 446 ) 447 `(,%let ,(map (lambda (s) 448 ;`(,(symbol-append prefix s) (,renamer ',s))) 449 `(,s (,renamer 450 ',(string->symbol 451 (substring (symbol->string s) 1))))) 452 %syms) 453 ,xpr ,@xprs)))))) 430 (define-er-macro (with-renamed-symbols (renamer . syms) xpr . xprs) 431 % 432 `(,%let ,(map (lambda (s) 433 `(,s (,renamer 434 ',(string->symbol 435 (substring (symbol->string s) 1))))) 436 syms) 437 ,xpr ,@xprs)) 454 438 455 439 ;;; (with-gensyms (name ....) xpr ....) 456 440 ;;; ----------------------------------- 457 441 ;;; binds name ... to (gensym 'name) ... in body xpr ... 458 (define-syntax with-gensyms 459 (ir-macro-transformer 460 (lambda (form inject compare?) 461 `(let ,(map (lambda (n) `(,n (gensym ',n))) (cadr form)) 462 ,@(cddr form))))) 442 (define-macro (with-gensyms (name . names) xpr . xprs) 443 (let ((names (cons name names)) (body (cons xpr xprs))) 444 `(let ,(map (lambda (n) `(,n (gensym ',n))) names) 445 ,@body))) 463 446 464 447 ;;; (procedural-macros sym ..)
Note: See TracChangeset
for help on using the changeset viewer.