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

refactoring, no semantic changes

Browse Source
This commit is contained in:
John Clements 2011-07-09 13:59:10 -07:00
parent 2cebd8f4cb
commit 592f28382b
1 changed files with 185 additions and 167 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
collects/stepper/private/reconstruct.rkt
View File

@ -245,29 +245,32 @@
#`(quote #,(string->symbol
(string-append "<DelayedEvaluation#" (number->string x) ">"))))
; This is used when we need the exp associated with a running promise, but the promise is at top-level,
; so it never gets added to partially-evaluated-promises-table
; This is used when we need the exp associated with a running promise, but the promise is at
; top-level, so it never gets added to partially-evaluated-promises-table
; This is a huge hack and I dont know if it the assumptions I'm making always hold
; (ie - that the exp associated with any running promise not in partially-evaluated-promises-table is the last so-far),
; (ie - that the exp associated with any running promise not in
; partially-evaluated-promises-table is the last so-far),
; but it's working for all test cases so far 10/29/2010.
; Another solution is to wrap all lazy programs in a dummy top-level expression???
; Update 11/1/2010: needed to add the following guards in the code to make the assumptions hold
; Update 11/1/2010: needed to add the following guards in the code to make the assumptions
; hold
; (guards are mainly triggered when there are infinite lists)
; - in recon-inner, dont add running promise to partially-evaluated-promises-table if so-far = nothing-so-far
; - in recon-inner, dont add running promise to partially-evaluated-promises-table if
; so-far = nothing-so-far
; - in recon, dont set last-so-far when so-far = nothing-so-far
; - in recon-value, dont use last-so-far if it hasnt been set (ie - if it's still null)
(define last-so-far null)
; ; ;;;
; ; ;
; ; ; ;;;
; ; ; ;
; ;;; ; ; ; ; ;;; ; ; ; ; ; ; ;;; ;;;; ;;; ; ;;; ;
; ; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ;; ; ;
; ; ; ; ; ; ; ;; ;; ;; ; ; ; ; ; ; ;
; ;; ;; ; ; ; ;;;;; ;; ;; ;; ;;;;; ;; ; ;;;;; ; ; ;
; ; ; ; ; ; ; ;; ;; ;; ; ; ; ; ; ;
; ; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ;; ;
; ;;; ; ; ; ; ;;; ; ; ; ; ; ; ;;; ;; ;;;; ; ;;; ;
; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ;; ; ;
; ; ; ; ; ; ;; ;; ;; ; ; ; ; ; ; ;
;; ;; ; ; ; ;;;;; ;; ;; ;; ;;;;; ;; ; ;;;;; ; ; ;
; ; ; ; ; ; ;; ;; ;; ; ; ; ; ; ;
; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ;; ;
;;; ; ; ; ; ;;; ; ; ; ; ; ; ;;; ;; ;;;; ; ;;; ;
; ;
; ;
; ; ;
; ; ;
(define (skip-step? break-kind mark-list render-settings)
(case break-kind
@ -277,7 +280,8 @@
(stepper-syntax-property expr 'stepper-hide-reduction)))]
[(result-exp-break)
;; skip if clauses that are the result of and/or reductions
(let ([and/or-clauses-consumed (stepper-syntax-property (mark-source (car mark-list)) 'stepper-and/or-clauses-consumed)])
(let ([and/or-clauses-consumed (stepper-syntax-property (mark-source (car mark-list))
'stepper-and/or-clauses-consumed)])
(and and/or-clauses-consumed
(> and/or-clauses-consumed 0)))]
[(normal-break normal-break/values)
@ -342,9 +346,9 @@
(struct-constructor-procedure? fun-val))))]
[else #f])))))
;; find-special-value finds the value associated with the given name. Applications of functions
;; like 'list' should not be shown as steps, because the before and after steps will be the same.
;; it might be easier simply to discover and discard these at display time.
;; find-special-value finds the value associated with the given name. Applications of
;; functions like 'list' should not be shown as steps, because the before and after steps will
;; be the same. it might be easier simply to discover and discard these at display time.
(define (find-special-value name valid-args)
(let* ([expanded-application (expand (cons name valid-args))]
[stepper-safe-expanded (skipto/auto expanded-application 'discard (lambda (x) x))]
@ -436,35 +440,36 @@
; recon-source-expr
; recon-source-expr produces the reconstructed version of a given source epxression, using the binding
; information contained in the binding-list. This happens during reconstruction whenever we come upon
; expressions that we haven't yet evaluated.
; recon-source-expr produces the reconstructed version of a given source epxression, using the
; binding information contained in the binding-list. This happens during reconstruction
; whenever we come upon expressions that we haven't yet evaluated.
; NB: the variable 'dont-lookup' contains a list of variables whose bindings occur INSIDE the expression
; being evaluated, and hence do NOT yet have values.
; NB: the variable 'dont-lookup' contains a list of variables whose bindings occur INSIDE the
; expression being evaluated, and hence do not yet have values.
; the 'use-lifted-names' vars are those bound by a let which does have lifted names. it is used in
; rendering the lifting of a let or local to show the 'after' step, which should show the lifted names.
; the 'use-lifted-names' vars are those bound by a let which does have lifted names. it is
; used in rendering the lifting of a let or local to show the 'after' step, which should show
; the lifted names.
(define/contract recon-source-expr
(-> syntax? mark-list? binding-set? binding-set? render-settings? syntax?)
(lambda (expr mark-list dont-lookup use-lifted-names render-settings)
(define (recur expr) (recon-source-expr expr mark-list dont-lookup
use-lifted-names render-settings))
(define (let-recur expr bindings)
(recon-source-expr expr mark-list (append bindings dont-lookup)
use-lifted-names render-settings))
(skipto/auto
expr
'discard
(lambda (expr)
(if (stepper-syntax-property expr 'stepper-prim-name)
(stepper-syntax-property expr 'stepper-prim-name)
(let* ([recur (lambda (expr) (recon-source-expr expr mark-list dont-lookup use-lifted-names render-settings))]
[let-recur (lambda (expr bindings)
(recon-source-expr expr mark-list (append bindings dont-lookup) use-lifted-names render-settings))]
[recon-basic
(lambda ()
(define (recon-basic)
(with-syntax ([(label . bodies) expr])
#`(label #,@(map recur (filter-skipped (syntax->list (syntax bodies)))))))]
[recon-let/rec
(lambda (rec?)
#`(label #,@(map recur (filter-skipped (syntax->list (syntax bodies)))))))
(define (recon-let/rec rec?)
(with-syntax ([(label ((vars val) ...) body ...) expr])
(let* ([bindings (map syntax->list (syntax->list (syntax (vars ...))))]
@ -475,26 +480,32 @@
[right-sides (map recur-fn (syntax->list (syntax (val ...))))]
[recon-bodies (map (lambda (x) (let-recur x binding-list))
(syntax->list #`(body ...)))])
(with-syntax ([(recon-val ...) right-sides]
(with-syntax
([(recon-val ...) right-sides]
[(recon-body ...) recon-bodies]
[(new-vars ...) (map (lx (map (lx (if (ormap (lambda (binding)
[(new-vars ...)
(map (lx (map (lx (if (ormap (lambda (binding)
(bound-identifier=? binding _))
use-lifted-names)
(stepper-syntax-property _
(stepper-syntax-property
_
'stepper-lifted-name
(binding-lifted-name mark-list _))
_))
_))
bindings)])
(syntax (label ((new-vars recon-val) ...) recon-body ...))))))]
[recon-lambda-clause
(lambda (clause)
(syntax (label ((new-vars recon-val) ...) recon-body ...))))))
(define (recon-lambda-clause clause)
(with-syntax ([(args . bodies-stx) clause])
(let* ([arglist (arglist-flatten #'args)]
[bodies (map (lambda (body) (let-recur body arglist))
(filter-skipped (syntax->list (syntax bodies-stx))))])
(cons (syntax args) bodies))))]
[recon (kernel:kernel-syntax-case
(cons (syntax args) bodies))))
(define (recon)
(kernel:kernel-syntax-case
expr #f
; lambda
@ -580,10 +591,14 @@
((stepper-temp)
(error 'recon-source-expr "stepper-temp showed up in source?!?"))
((non-lexical)
(error 'recon-source-expr "can't get here: lexical identifier labeled as non-lexical"))
(error
'recon-source-expr
"can't get here: lexical identifier labeled as non-lexical"))
(else
(error 'recon-source-expr "unknown 'stepper-binding-type property: ~a on var: ~a"
(stepper-syntax-property var 'stepper-binding-type) (syntax->datum var)))))]
(error 'recon-source-expr
"unknown 'stepper-binding-type property: ~a on var: ~a"
(stepper-syntax-property var 'stepper-binding-type)
(syntax->datum var)))))]
[else ; top-level-varref
(fixup-name
var)])))]
@ -593,8 +608,11 @@
[else
(error 'recon-source "no matching clause for syntax: ~a" (if (syntax? expr)
(syntax->datum expr)
expr))])])
(attach-info recon expr)))))))
expr))]))
(if (stepper-syntax-property expr 'stepper-prim-name)
(stepper-syntax-property expr 'stepper-prim-name)
(let* ()
(attach-info (recon) expr)))))))
;; reconstruct-set!-var