suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix struct constructor application in lazy racket

Browse Source
This commit is contained in:
Stephen Chang 2011-04-19 01:21:19 -04:00
parent cdb63b9c77
commit 718b9709bc
3 changed files with 25 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/lazy/lazy.rkt
View File

@ -254,6 +254,8 @@
;; `!apply': provided as `apply' (no need to provide `~!apply', since all
;; function calls are delayed by `#%app')
(define (extract-if-lazy-proc f)
(or (procedure-extract-target f) f))
(define-syntax (!*app stx)
(syntax-case stx ()
[(_ f x ...)
@ -271,7 +273,7 @@
skipto/first)))])
(with-syntax ([(y ...) (generate-temporaries #'(x ...))])
;; use syntax/loc for better errors etc
(with-syntax ([lazy (syntax/loc stx ((procedure-extract-target p) y ...))]
(with-syntax ([lazy (syntax/loc stx ((extract-if-lazy-proc p) y ...))]
[strict (syntax/loc stx (p (hidden-! y) ...))])
(quasisyntax/loc stx
((lambda (p y ...)

13
collects/stepper/private/macro-unwind.rkt
View File

@ -59,14 +59,15 @@
[(define-values dc ...)
(unwind-define stx settings)]
; STC: app special cases from lazy racket
; procedure-extract-target - can't hide this in lazy.rkt bc it's needed
; extract-if-lazy-proc - can't hide this in lazy.rkt bc it's needed
; to distinguish the general lazy application
[(#%plain-app proc-extract p)
(or (eq? (syntax->datum #'proc-extract) 'procedure-extract-target)
(eq? (with-handlers ; for print output-style
(or (eq? (syntax->datum #'proc-extract) 'extract-if-lazy-proc)
(eq? (object-name
(with-handlers ; for print output-style
([(λ (e) #t) (λ (e) #f)])
(syntax-e (second (syntax-e #'proc-extract))))
procedure-extract-target))
(syntax-e (second (syntax-e #'proc-extract)))))
'extract-if-lazy-proc))
(unwind #'p settings)]
; lazy #%app special case: force and delay
[(#%plain-app f arg)
@ -80,7 +81,7 @@
[(#%plain-app
(#%plain-lambda args1 (#%plain-app (#%plain-app proc p) . args2))
. args3)
(and (eq? (syntax->datum #'proc) 'procedure-extract-target)
(and (eq? (syntax->datum #'proc) 'extract-if-lazy-proc)
(equal? (syntax->datum (cdr (syntax-e #'args1)))
(syntax->datum #'args2)))
(recur-on-pieces #'args3 settings)]

15
collects/tests/lazy/lang.rkt
View File

@ -68,8 +68,21 @@
(!! (take 1 (cons 0 (error "poof")))) => '(0)
))
(define (misc-tests)
(define-struct a (b c))
(define-struct d (e f))
(test
(! (a-b (make-a 1 2))) => 1
(! (a-c (make-a 1 2))) => 2
(! (a-b (a 1 2))) => 1
(! (a-c (a 1 2))) => 2
(! (a? (a 1 2))) => true
(! (a? (d 1 2))) => false
))
(provide lang-tests)
(define (lang-tests)
(! (begin (basic-tests)
(list-tests)
(take-tests))))
(take-tests)
(misc-tests))))