conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

simplified parameterize macro.

This commit is contained in:
Abdulaziz Ghuloum 2008-08-02 10:11:04 -07:00
parent 9b74020647
commit 39e84d1395
4 changed files with 25 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
scheme/ikarus.compiler.altcogen.ss
View File

@ -327,12 +327,12 @@
(define all-registers
(case wordsize
[(4) '(%eax %edi %ebx %edx %ecx)]
[else '(%eax %edi %ebx %edx %ecx %r8 %r9 %r10 %r11)]))
[else '(%eax %edi %ebx %edx %ecx %r8 %r9 %r10 %r11 %r14 %r15)]))
(define non-8bit-registers
(case wordsize
[(4) '(%edi)]
[else '(%edi %r8 %r9 %r10 %r11)]))
[else '(%edi %r8 %r9 %r10 %r11 %r14 %r15)]))
(define argc-register '%eax)

2
scheme/last-revision
View File

@ -1 +1 @@
1564
1565

2
scheme/makefile.ss
View File

@ -130,7 +130,6 @@
[if (core-macro . if)]
[when (core-macro . when)]
[unless (core-macro . unless)]
[parameterize (core-macro . parameterize)]
[case (core-macro . case)]
[fluid-let-syntax (core-macro . fluid-let-syntax)]
[record-type-descriptor (core-macro . record-type-descriptor)]
@ -145,6 +144,7 @@
[quasisyntax (macro . quasisyntax)]
[with-syntax (macro . with-syntax)]
[identifier-syntax (macro . identifier-syntax)]
[parameterize (macro . parameterize)]
[let (macro . let)]
[let* (macro . let*)]
[cond (macro . cond)]

56
scheme/psyntax.expander.ss
View File

@ -2066,42 +2066,28 @@
(define incorrect-usage-macro
(lambda (e) (stx-error e "incorrect usage of auxiliary keyword")))
(define parameterize-transformer ;;; go away
(lambda (e r mr)
(define parameterize-macro
(lambda (e)
(syntax-match e ()
((_ () b b* ...)
(chi-internal (cons b b*) r mr))
((_ () b b* ...)
(bless `(begin ,b . ,b*)))
((_ ((olhs* orhs*) ...) b b* ...)
(let ((lhs* (map (lambda (x) (gen-lexical 'lhs)) olhs*))
(rhs* (map (lambda (x) (gen-lexical 'rhs)) olhs*))
(t* (map (lambda (x) (gen-lexical 't)) olhs*))
(swap (gen-lexical 'swap)))
(build-let no-source
(append lhs* rhs*)
(append (chi-expr* olhs* r mr) (chi-expr* orhs* r mr))
(build-let no-source
(list swap)
(list (build-lambda no-source '()
(build-sequence no-source
(map (lambda (t lhs rhs)
(build-let no-source
(list t)
(list (build-application no-source
(build-lexical-reference no-source lhs)
'()))
(build-sequence no-source
(list (build-application no-source
(build-lexical-reference no-source lhs)
(list (build-lexical-reference no-source rhs)))
(build-lexical-assignment no-source rhs
(build-lexical-reference no-source t))))))
t* lhs* rhs*))))
(build-application no-source
(build-primref no-source 'dynamic-wind)
(list (build-lexical-reference no-source swap)
(build-lambda no-source '()
(chi-internal (cons b b*) r mr))
(build-lexical-reference no-source swap))))))))))
(let ((lhs* (generate-temporaries olhs*))
(rhs* (generate-temporaries orhs*)))
(bless
`((lambda ,(append lhs* rhs*)
(let ([swap (lambda ()
,@(map (lambda (lhs rhs)
`(let ([t (,lhs)])
(,lhs ,rhs)
(set! ,rhs t)))
lhs* rhs*))])
(dynamic-wind
swap
(lambda () ,b . ,b*)
swap)))
,@(append olhs* orhs*))))))))
(define foreign-call-transformer
(lambda (e r mr)
@ -2598,7 +2584,6 @@
((if) if-transformer)
((when) when-transformer)
((unless) unless-transformer)
((parameterize) parameterize-transformer)
((foreign-call) foreign-call-transformer)
((syntax-case) syntax-case-transformer)
((syntax) syntax-transformer)
@ -2661,6 +2646,7 @@
((trace-let-syntax) trace-let-syntax-macro)
((trace-letrec-syntax) trace-letrec-syntax-macro)
((define-condition-type) define-condition-type-macro)
((parameterize) parameterize-macro)
((include-into) include-into-macro)
((eol-style)
(lambda (x)