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

cs & schemify: fix set!-vs.-define tracking

Browse Source
This commit is contained in:
Matthew Flatt 2019-06-29 07:00:39 -06:00
parent 2bff59766d
commit efeb9116d5
8 changed files with 49 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "7.3.0.9")
(define version "7.3.0.10")
(define deps `("racket-lib"
["racket" #:version ,version]))

20
racket/src/cs/linklet.sls
View File

@ -53,6 +53,7 @@
;; schemify glue:
make-internal-variable
variable-set!
variable-set!/define
variable-set!/check-undefined
variable-ref
variable-ref/no-check
@ -234,7 +235,8 @@
(define (outer-eval s paths format)
(if (eq? format 'interpret)
(interpret-linklet s paths primitives variable-ref variable-ref/no-check variable-set!
(interpret-linklet s paths primitives variable-ref variable-ref/no-check
variable-set! variable-set!/define
make-arity-wrapper-procedure)
(let ([proc (compile* s)])
(if (null? paths)
@ -759,7 +761,7 @@
(|#%app|
exn:fail:contract:variable
(string-append (symbol->string (variable-source-name var))
": cannot modify constant")
": cannot modify a constant")
(current-continuation-marks)
(variable-name var)))])]
[else
@ -767,13 +769,16 @@
(when constance
(set-variable-constance! var constance))]))
(define (variable-set! var val constance)
(do-variable-set! var val constance #f))
(define (variable-set! var val)
(do-variable-set! var val #f #f))
(define (variable-set!/check-undefined var val constance)
(define (variable-set!/define var val constance)
(do-variable-set! var val constance #t))
(define (variable-set!/check-undefined var val)
(when (eq? (variable-val var) variable-undefined)
(raise-undefined var #t))
(variable-set! var val constance))
(variable-set! var val))
(define (variable-ref var)
(let ([v (variable-val var)])
@ -976,7 +981,7 @@
(let ([var (make-variable variable-undefined k k #f (weak-cons i #f))])
(hash-set! (instance-hash i) k var)
var))])
(variable-set! var v mode))]))
(do-variable-set! var v mode #f))]))
(define (instance-unset-variable! i k)
(unless (instance? i)
@ -1138,6 +1143,7 @@
(primitive-table
variable-set!
variable-set!/check-undefined
variable-set!/define
variable-ref
variable-ref/no-check
make-instance-variable-reference

1
racket/src/expander/compile/built-in-symbol.rkt
View File

@ -62,6 +62,7 @@
variable-ref
variable-ref/no-check
variable-set!/check-undefined
variable-set!/define
make-instance-variable-reference
instance-variable-reference
annotation?

2
racket/src/racket/src/schvers.h
View File

@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 9
#define MZSCHEME_VERSION_W 10
/* A level of indirection makes `#` work as needed: */
#define AS_a_STR_HELPER(x) #x

1
racket/src/racket/src/startup.inc
View File

@ -19873,6 +19873,7 @@ static const char *startup_source =
" variable-ref"
" variable-ref/no-check"
" variable-set!/check-undefined"
" variable-set!/define"
" make-instance-variable-reference"
" instance-variable-reference"
" annotation?"

33
racket/src/schemify/interpret.rkt
View File

@ -320,13 +320,22 @@
ids
constances
(compile-list vars env stack-depth stk-i #f))]
[`(variable-set! ,dest-id ,e ',constance)
[`(variable-set! ,dest-id ,e)
(define dest-var (hash-ref env (unwrap dest-id)))
(define new-expr (compile-expr e env stack-depth stk-i #f))
(vector 'set-variable!
(stack->pos dest-var stk-i)
new-expr
constance)]
#f
#f)]
[`(variable-set!/define ,dest-id ,e ',constance)
(define dest-var (hash-ref env (unwrap dest-id)))
(define new-expr (compile-expr e env stack-depth stk-i #f))
(vector 'set-variable!
(stack->pos dest-var stk-i)
new-expr
constance
#t)]
[`(variable-ref ,id)
(define var (hash-ref env (unwrap id)))
(vector 'ref-variable/checked (stack->pos var stk-i))]
@ -425,7 +434,7 @@
paths ; unmarshaled paths
primitives ; hash of symbol -> value
;; the implementation of variables:
variable-ref variable-ref/no-check variable-set!
variable-ref variable-ref/no-check variable-set! variable-set!/define
;; to create a procedure with a specific arity mask:
make-arity-wrapper-procedure)
(interp-match
@ -441,7 +450,7 @@
(vector-set! vec i (car paths))
(cdr paths)]
[else
(vector-set! vec i (interpret-expr b stack primitives void void void void))
(vector-set! vec i (interpret-expr b stack primitives void void void void void))
paths]))
vec))])
(lambda args
@ -454,10 +463,10 @@
(define post-args-pos (stack-count args-stack))
(define stack (for/fold ([stack args-stack]) ([i (in-range num-body-vars)])
(stack-set stack (+ i post-args-pos) (box unsafe-undefined))))
(interpret-expr b stack primitives variable-ref variable-ref/no-check variable-set!
(interpret-expr b stack primitives variable-ref variable-ref/no-check variable-set! variable-set!/define
make-arity-wrapper-procedure)))]))
(define (interpret-expr b stack primitives variable-ref variable-ref/no-check variable-set!
(define (interpret-expr b stack primitives variable-ref variable-ref/no-check variable-set! variable-set!/define
make-arity-wrapper-procedure)
;; Returns `result ...` when `tail?` is #t, and
@ -711,10 +720,12 @@
(if tail?
val
(values new-stack val))]
[#(set-variable! ,s ,b ,c)
[#(set-variable! ,s ,b ,c ,defn?)
(define-values (var-stack var) (stack-ref stack s))
(define-values (val-stack val) (interpret b var-stack))
(variable-set! var val c)
(if defn?
(variable-set!/define var val c)
(variable-set! var val))
(if tail?
(void)
(values val-stack (void)))]
@ -826,7 +837,7 @@
(list x y (let ([z 2])
z)))))
(define-values (one two) (values 100 200))
(variable-set! two-box two 'constant)
(variable-set!/define two-box two 'constant)
(letrec ([ok 'ok])
(set! other (call-with-values (lambda () (values 71 (begin0 88 ok)))
(lambda (v q) (list q v))))
@ -838,7 +849,7 @@
(continuation-mark-set-first #f 'x 'no))))))
values))
(pretty-print b)
(define l (interpret-linklet b primitives var-val var-val (lambda (b v c)
(set-var-val! b v))
(define l (interpret-linklet b null primitives var-val var-val
(lambda (b v) (set-var-val! b v)) (lambda (b v c) (set-var-val! b v))
(lambda (proc mask name) proc)))
(l 'the-x (var #f)))

14
racket/src/schemify/jitify.rkt
View File

@ -146,6 +146,8 @@
(match v
[`(variable-set! ,var-id ,id . ,_)
(hash-set env (unwrap id) `(variable-ref ,(unwrap var-id)))]
[`(variable-set!/define ,var-id ,id . ,_)
(hash-set env (unwrap id) `(variable-ref ,(unwrap var-id)))]
[`(call-with-module-prompt ,_ ',ids ,_ ,var-ids ...)
(for/fold ([env env]) ([id (in-list ids)]
[var-id (in-list var-ids)])
@ -159,7 +161,7 @@
(let loop ([body body])
(for/list ([v (in-list body)])
(match v
[`(variable-set! ,var-id ,id ',constance)
[`(variable-set!/define ,var-id ,id ',constance)
(when constance
;; From now on, a direct reference is ok
(set! top-env (hash-set top-env (unwrap id) '#:direct)))
@ -316,7 +318,7 @@
(match (hash-ref env id '#:direct)
[`#:direct (reannotate v `(set! ,var ,new-rhs))]
[`(self ,m . ,_) (error 'set! "[internal error] self-referenceable ~s" id)]
[`(variable-ref ,var-id) (reannotate v `(variable-set! ,var-id ,new-rhs '#f))]
[`(variable-ref ,var-id) (reannotate v `(variable-set! ,var-id ,new-rhs))]
[`(unbox ,box-id) (reannotate v `(set-box! ,box-id ,new-rhs))]
[`(unbox/check-undefined ,box-id ,_) (reannotate v `(set-box!/check-undefined ,box-id ,new-rhs ',var))]))
(values new-v newer-free new-lifts)])]
@ -834,9 +836,9 @@
[selfy (lambda (x) (vector (selfy x) selfy))])
(odd 5)))
(define top-selfx (lambda (x) (top-selfx x)))
(variable-set! top-selfx-var top-selfx 'const)
(variable-set!/define top-selfx-var top-selfx 'const)
(define top-selfy (lambda (x) (vector (top-selfy x) top-selfy)))
(variable-set! top-selfy-var top-selfy 'const)
(variable-set!/define top-selfy-var top-selfy 'const)
(call-with-values (lambda (x) (x (lambda (w) (w))))
(lambda (z w) 10))
(call-with-values (lambda (x) (x (lambda (w) (w))))
@ -851,7 +853,7 @@
(define x1 (lambda () (lambda () (other iv))))
(define x2 (lambda () (letrec ([other (lambda () (other iv))])
other)))
(define whatever (begin (variable-set! xv x 'const) (void)))
(define whatever (begin (variable-set!/define xv x 'const) (void)))
(define end (letrec ([w (lambda (x) (let ([proc (lambda (x) x)])
(proc q)))]
[q q])
@ -859,7 +861,7 @@
(define topz (letrec ([helper (lambda (x)
(helper (topz x)))])
(lambda (y) (helper y))))
(variable-set! topz-var topz 'const)
(variable-set!/define topz-var topz 'const)
(do-immediate topz)
(define sets-arg (lambda (x)
(values (lambda () (set! x (add1 x)))

4
racket/src/schemify/schemify.rkt
View File

@ -347,7 +347,7 @@
(define (make-set-variable id exports knowns mutated [extra-variables #f])
(define int-id (unwrap id))
(define ex-id (id-to-variable int-id exports knowns mutated extra-variables))
`(variable-set! ,ex-id ,id ',(variable-constance int-id knowns mutated)))
`(variable-set!/define ,ex-id ,id ',(variable-constance int-id knowns mutated)))
(define (id-to-variable int-id exports knowns mutated extra-variables)
(export-id
@ -550,7 +550,7 @@
(define new-rhs (schemify rhs))
(cond
[ex
`(,(if allow-set!-undefined? 'variable-set! 'variable-set!/check-undefined) ,(export-id ex) ,new-rhs '#f)]
`(,(if allow-set!-undefined? 'variable-set! 'variable-set!/check-undefined) ,(export-id ex) ,new-rhs)]
[else
(define state (hash-ref mutated int-id #f))
(cond