Changeset 38710 in project


Ignore:
Timestamp:
05/28/20 17:08:14 (5 months ago)
Author:
juergen
Message:

procedural-macros 3.0.1 with simplyfied code

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  
    55 (dependencies bindings)
    66 (author "Juergen Lorenz")
    7  (version "3.0")
     7 (version "3.0.1")
    88 (components
    99   (extension procedural-macros
  • release/5/procedural-macros/tags/3.0.1/procedural-macros.scm

    r38670 r38710  
    416416;;; The code is more or less due to
    417417;;; 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))))))
    433427
    434428;;; (with-renamed-symbols (renamer . %syms) xpr . xprs)
    435429;;; ---------------------------------------------------
    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))
    454438
    455439;;; (with-gensyms (name ....) xpr ....)
    456440;;; -----------------------------------
    457441;;; 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)))
    463446
    464447;;; (procedural-macros sym ..)
  • release/5/procedural-macros/trunk/procedural-macros.egg

    r38670 r38710  
    55 (dependencies bindings)
    66 (author "Juergen Lorenz")
    7  (version "3.0")
     7 (version "3.0.1")
    88 (components
    99   (extension procedural-macros
  • release/5/procedural-macros/trunk/procedural-macros.scm

    r38670 r38710  
    416416;;; The code is more or less due to
    417417;;; 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))))))
    433427
    434428;;; (with-renamed-symbols (renamer . %syms) xpr . xprs)
    435429;;; ---------------------------------------------------
    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))
    454438
    455439;;; (with-gensyms (name ....) xpr ....)
    456440;;; -----------------------------------
    457441;;; 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)))
    463446
    464447;;; (procedural-macros sym ..)
Note: See TracChangeset for help on using the changeset viewer.