[racket-dev] [plt] Push #23279: master branch updated

On Wed, Aug 17, 2011 at 7:23 AM,  <mflatt at racket-lang.org> wrote:
> mflatt has updated `master' from a221e4bba2 to dfd58a2cdd.
>  http://git.racket-lang.org/plt/a221e4bba2..dfd58a2cdd
>
> =====[ 1 Commits ]======================================================
>
> Directory summary:
>  91.2% collects/racket/
>   8.7% collects/tests/racket/
>
> ~~~~~~~~~~
>
> dfd58a2 Matthew Flatt <mflatt at racket-lang.org> 2011-08-17 06:18
> :
> | adjust sandbox to give S-expression input "original" status
> :
>  M collects/racket/sandbox.rkt        |   19 ++++++++++++++++---
>  M collects/tests/racket/sandbox.rktl |    5 +++++
>
> =====[ Overall Diff ]===================================================
>
> collects/racket/sandbox.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/racket/sandbox.rkt
> +++ NEW/collects/racket/sandbox.rkt
> @@ -474,11 +474,24 @@
>                       (loop (cdr inps) (and n (add1 n))
>                             ;; 1st at line#1, pos#1, 2nd at line#2, pos#2 etc
>                             ;; (starting from the `n' argument)
> -                            (cons (datum->syntax
> -                                   #f (car inps)
> -                                   (list source n (and n 0) n (and n 1)))
> +                            (cons (add-location (car inps)
> +                                                (list source n (and n 0) n (and n 1)))

Why does syntax always get column 0 and position 1 (if they're set at all)?

>                                   r))))]))))
>
> +(define orig-stx (read-syntax 'src (open-input-string "0"))) ; for "is original?" property
> +(define (make-orig x loc) (datum->syntax #f x loc orig-stx))
> +
> +(define (add-location x loc)
> +  (cond
> +   [(null? x) null]
> +   [(pair? x) (make-orig (cons (add-location (car x) loc)
> +                               (add-location (cdr x) loc))
> +                         loc)]
> +   [(vector? x) (make-orig (for/vector ([i (in-vector x)])
> +                             (add-location i loc))
> +                           loc)]
> +   [else (make-orig x loc)]))
> +
>  (define ((init-hook-for-language language))
>   (cond [(or (not (pair? language))
>              (not (eq? 'special (car language))))
>
> collects/tests/racket/sandbox.rktl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/tests/racket/sandbox.rktl
> +++ NEW/collects/tests/racket/sandbox.rktl
> @@ -493,6 +493,11 @@
>         =err> "out of mem+o(?:ry)"
>         b => 1))
>
> +   --top--
> +   (make-base-evaluator!)
> +   --eval--
> +   (syntax-original? #'x) => #t
> +
>    ))
>
>  (report-errs)
>