From bcd850ac32bcaf52f308a113b2120c74d1d946f2 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 9 Oct 2006 03:45:18 +0000 Subject: [PATCH] propagate some changes: special evaluation of toplevel expressions etc svn: r4527 --- collects/lazy/lazy.ss | 52 ++++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/collects/lazy/lazy.ss b/collects/lazy/lazy.ss index ff3b701f7a..674f14411f 100644 --- a/collects/lazy/lazy.ss +++ b/collects/lazy/lazy.ss @@ -202,18 +202,22 @@ [$ (lambda (stx) (syntax-property stx 'stepper-skipto '(syntax-e cdr syntax-e car)))]) - (with-syntax ([(y ...) (generate-temporaries #'(x ...))]) - ;; use syntax/loc for better errors etc - (with-syntax ([lazy (quasisyntax/loc stx (p y ...))] - [strict (quasisyntax/loc stx (p (hidden-! y) ...))]) - (quasisyntax/loc stx - (let ([p f] [y x] ...) - #,($$ #`(if (lazy? p) lazy strict)))))))])) + (with-syntax ([(y ...) (generate-temporaries #'(x ...))]) + ;; use syntax/loc for better errors etc + (with-syntax ([lazy (syntax/loc stx (p y ...))] + [strict (syntax/loc stx (p (hidden-! y) ...))]) + (quasisyntax/loc stx + (let ([p f] [y x] ...) + #,($$ #`(if (lazy? p) lazy strict)))))))])) (defsubst (!app f x ...) (!*app (hidden-! f) x ...)) (defsubst (~!*app f x ...) (~ (!*app f x ...))) (defsubst (~!app f x ...) (~ (!app f x ...))) + (define-for-syntax (toplevel?) + (memq (syntax-local-context) + '(top-level module module-begin))) ; not sure about module-begin + (provide (rename ~!%app #%app)) ; all applications are delayed (define-syntax (~!%app stx) ; provided as #%app (define (unwinder stx rec) @@ -236,7 +240,11 @@ [(_ !!list x) (syntax/loc stx (!!list x))] [(_ !values x) (syntax/loc stx (!values x))] [(_ !!values x) (syntax/loc stx (!!values x))] - [(_ f x ...) (stepper-annotate (syntax/loc stx (~!app f x ...)))])) + [(_ f x ...) + (if (toplevel?) + ;; toplevel expressions are always forced + (syntax/loc stx (! (!app f x ...))) + (stepper-annotate (syntax/loc stx (~!app f x ...))))])) (define (!*apply f . xs) (let ([xs (!list (apply list* xs))]) @@ -249,6 +257,12 @@ (provide (rename !apply apply)) ; can only be used through #%app => delayed + ;; do the same special treatment for toplevel variable expressions + (provide (rename !top #%top)) + (define-syntax (!top stx) + (syntax-case stx () + [(_ . id) (if (toplevel?) #'(! (#%top . id)) #'(#%top . id))])) + ;; used for explicitly strict/lazy calls (defsubst (strict-call f x ...) (~ (f (! x) ...))) (defsubst (lazy-call f x ...) (~ (f x ...))) @@ -625,12 +639,9 @@ (if (! (pred x)) (cons x xs) xs))) (else (error 'filter "not a proper list: ~e" list))))) - (require (rename (lib "list.ss") !quicksort quicksort) - (rename (lib "list.ss") !mergesort mergesort)) - (define* (quicksort list less-than) - (!quicksort (!list list) (! less-than))) - (define* (mergesort list less-than) - (!mergesort (!list list) (! less-than))) + (require (rename (lib "list.ss") !sort sort)) + (define* (sort list less-than) + (!sort (!list list) (! less-than))) ;; -------------------------------------------------------------------------- ;; (lib "etc.ss") functionality @@ -678,7 +689,7 @@ [~id (string->symbol (string-append "~" str))]) (datum->syntax-object id ~id id))) (syntax->list #'(id ...)))]) - #'(provide (all-from-except mzscheme module #%app apply id ...) + #'(provide (all-from-except mzscheme module #%app apply #%top id ...) (rename ~id id) ...))])) (renaming-provide lambda define let let* letrec parameterize @@ -702,21 +713,12 @@ ;; `list' stuff first second third fourth fifth sixth seventh eighth rest cons? empty empty? foldl foldr last-pair remove remq remv remove* remq* remv* memf assf filter - quicksort mergesort + sort ;; `etc' stuff true false boolean=? symbol=? identity compose build-list ;; extra stuff for lazy Scheme take cycle) - ;; -------------------------------------------------------------------------- - ;; Initialize special evaluation hooks - - ;; taking this out so that stepper test cases will work correctly: - - #; - (let ([prim-eval (current-eval)]) - (current-eval (lambda (expr) (!! (prim-eval expr))))) - ) #|