diff --git a/collects/compiler/decompile.ss b/collects/compiler/decompile.ss index 4c009cdcd1..aa851a4052 100644 --- a/collects/compiler/decompile.ss +++ b/collects/compiler/decompile.ss @@ -266,6 +266,7 @@ (define (decompile-lam expr globs stack) (match expr + [(struct closure (lam gen-id)) (decompile-lam lam globs stack)] [(struct lam (name flags num-params rest? closure-map max-let-depth body)) (let ([vars (for/list ([i (in-range num-params)]) (gensym (format "arg~a-" i)))] diff --git a/collects/compiler/main.ss b/collects/compiler/main.ss index 369b942990..456823c1f4 100644 --- a/collects/compiler/main.ss +++ b/collects/compiler/main.ss @@ -453,7 +453,8 @@ (for ([zo-file source-files]) (let ([zo-file (path->complete-path zo-file)]) (let-values ([(base name dir?) (split-path zo-file)]) - (parameterize ([current-load-relative-directory base]) + (parameterize ([current-load-relative-directory base] + [print-graph #t]) (pretty-print (decompile (call-with-input-file* diff --git a/collects/compiler/zo-parse.ss b/collects/compiler/zo-parse.ss index cc44ec16fe..f73b98d2ce 100644 --- a/collects/compiler/zo-parse.ss +++ b/collects/compiler/zo-parse.ss @@ -306,7 +306,7 @@ ;; not sure if it's really unsigned (integer-bytes->integer (read-bytes 4 p) #f #f)) -(define-struct cport ([pos #:mutable] orig-port size bytes symtab shared-offsets)) +(define-struct cport ([pos #:mutable] orig-port size bytes symtab shared-offsets decoded rns)) (define (cp-getc cp) (begin-with-definitions @@ -426,6 +426,124 @@ (define-struct not-ready ()) +;; ---------------------------------------- +;; Synatx unmarshaling + +(define-form-struct wrapped (datum wraps certs)) + +(define (decode-stx cp v) + (if (integer? v) + (let-values ([(v2 decoded?) (unmarshal-stx-get cp v)]) + (if decoded? + v2 + (let ([v2 (decode-stx cp v2)]) + (unmarshal-stx-set! cp v v2) + v2))) + (let loop ([v v]) + (let-values ([(cert-marks v encoded-wraps) + (match v + [`#((,datum . ,wraps) ,cert-marks) (values cert-marks datum wraps)] + [`(,datum . ,wraps) (values #f datum wraps)] + [else (error 'decode-wraps "bad datum+wrap: ~e" v)])]) + (let* ([wraps (decode-wraps cp encoded-wraps)] + [add-wrap (lambda (v) (make-wrapped v wraps cert-marks))]) + (cond + [(pair? v) + (if (eq? #t (car v)) + ;; Share decoded wraps with all nested parts. + (let loop ([v (cdr v)]) + (cond + [(pair? v) + (let ploop ([v v]) + (cond + [(null? v) null] + [(pair? v) (add-wrap (cons (loop (car v)) (ploop (cdr v))))] + [else (loop v)]))] + [(box? v) (add-wrap (box (loop (unbox v))))] + [(vector? v) + (add-wrap (list->vector (map loop (vector->list v))))] + [(prefab-struct-key v) + => (lambda (k) + (add-wrap + (apply + make-prefab-struct + k + (map loop (cdr (vector->list (struct->vector v)))))))] + [else (add-wrap v)])) + ;; Decode sub-elements that have their own wraps: + (let-values ([(v counter) (if (exact-integer? (car v)) + (values (cdr v) (car v)) + (values v -1))]) + (add-wrap + (let ploop ([v v][counter counter]) + (cond + [(null? v) null] + [(or (not (pair? v)) (zero? counter)) (loop v)] + [(pair? v) (cons (loop (car v)) + (ploop (cdr v) (sub1 counter)))])))))] + [(box? v) (add-wrap (box (loop (unbox v))))] + [(vector? v) + (add-wrap (list->vector (map loop (vector->list v))))] + [(prefab-struct-key v) + => (lambda (k) + (add-wrap + (apply + make-prefab-struct + k + (map loop (cdr (vector->list (struct->vector v)))))))] + [else (add-wrap v)])))))) + +(define (decode-wraps cp w) + (if (integer? w) + (let-values ([(w2 decoded?) (unmarshal-stx-get cp w)]) + (if decoded? + w2 + (let ([w2 (decode-wraps cp w2)]) + (unmarshal-stx-set! cp w w2) + w2))) + (map (lambda (a) + (let aloop ([a a]) + (cond + [(integer? a) + (let-values ([(a2 decoded?) (unmarshal-stx-get cp a)]) + (if decoded? + a2 + (let ([a2 (aloop a2)]) + (unmarshal-stx-set! cp a a2) + a2)))] + [(and (pair? a) (null? (cdr a)) (number? (car a))) + ;; a mark + (string->symbol (format "mark~a" (car a)))] + [(vector? a) + `(#%decode-lexical-rename ,a)] + [(pair? a) + `(#%decode-module-rename ,a)] + [(boolean? a) + `(#%top-level-rename ,a)] + [(symbol? a) + '(#%mark-barrier)] + [(box? a) + `(#%phase-shift ,(unbox a))] + [else (error 'decode-wraps "bad wrap element: ~e" a)]))) + w))) + +(define (unmarshal-stx-get cp pos) + (if (pos . >= . (vector-length (cport-symtab cp))) + (values `(#%bad-index ,pos) #t) + (let ([v (vector-ref (cport-symtab cp) pos)]) + (if (not-ready? v) + (let ([save-pos (cport-pos cp)]) + (set-cport-pos! cp (vector-ref (cport-shared-offsets cp) (sub1 pos))) + (let ([v (read-compact cp)]) + (vector-set! (cport-symtab cp) pos v) + (set-cport-pos! cp save-pos) + (values v #f))) + (values v (vector-ref (cport-decoded cp) pos)))))) + +(define (unmarshal-stx-set! cp pos v) + (vector-set! (cport-symtab cp) pos v) + (vector-set! (cport-decoded cp) pos #t)) + ;; ---------------------------------------- ;; Main parsing loop @@ -535,7 +653,7 @@ [(marshalled) (read-marshalled (read-compact-number cp) cp)] [(stx) (let ([v (make-reader-graph (read-compact cp))]) - (make-stx v))] + (make-stx (decode-stx cp v)))] [(local local-unbox) (let ([c (read-compact-number cp)] [unbox? (eq? cpt-tag 'local-unbox)]) @@ -666,7 +784,7 @@ (define symtab (make-vector symtabsize (make-not-ready))) - (define cp (make-cport 0 port size* rst symtab so*)) + (define cp (make-cport 0 port size* rst symtab so* (make-vector symtabsize #f) (make-hash))) (for/list ([i (in-range 1 symtabsize)]) (when (not-ready? (vector-ref symtab i)) (set-cport-pos! cp (vector-ref so* (sub1 i))) diff --git a/collects/handin-server/checker.ss b/collects/handin-server/checker.ss index b51f4adfd0..aaa896522a 100644 --- a/collects/handin-server/checker.ss +++ b/collects/handin-server/checker.ss @@ -320,7 +320,9 @@ (provide add-header-line!) (define (add-header-line! line) (let ([new (list line)] [cur (thread-cell-ref added-lines)]) - (if cur (append cur new) (thread-cell-set! added-lines new)))) + (if cur + (set-box! cur (append (unbox cur) new)) + (thread-cell-set! added-lines (box new))))) (define ((wrap-evaluator eval) expr) (define unknown "unknown") @@ -477,7 +479,7 @@ (prefix-line (user-substs user student-line))) (for-each prefix-line/substs extra-lines) (for-each prefix-line/substs - (or (thread-cell-ref added-lines) '())) + (unbox (or (thread-cell-ref added-lines) (box '())))) (display submission-text)))) (define submission-text (and create-text? @@ -697,6 +699,15 @@ (error* "your code failed a test: ~e evaluated to ~e, expecting ~e" (->disp 'expr) (->disp val) (->disp result))))])) +(provide !test/exn) +(define-syntax (!test/exn stx) + (syntax-case stx () + [(_ test-exp) + #`(with-handlers ([exn:fail? (lambda (exn) #t)]) + ((submission-eval) `test-exp) + (error* "expected exception on test expression: ~v" + (->disp 'test-exp)))])) + (provide !all-covered) (define coverage-checked (make-thread-cell #f)) (define (!all-covered . proc) diff --git a/collects/handin-server/main.ss b/collects/handin-server/main.ss index 8c58415ff1..6c7e22c6f8 100644 --- a/collects/handin-server/main.ss +++ b/collects/handin-server/main.ss @@ -542,78 +542,76 @@ ((current-timeout-control) msg)) (define (with-watcher w proc) - (let ([session-cust (make-custodian)] - [session-channel (make-channel)] - [timeout #f] - [status-box (box #f)]) - (define (timeout-control msg) - (if (rational? msg) - (set! timeout (+ (current-inexact-milliseconds) (* 1000 msg))) - (case msg - [(reset) (timeout-control (get-conf 'session-timeout))] - [(disable) (set! timeout #f)] - [else (error 'timeout-control "bad argument: ~s" msg)]))) - (current-timeout-control timeout-control) - (timeout-control 'reset) - (unless no-limit-warning? - (with-handlers ([exn:fail:unsupported? - (lambda (x) - (set! no-limit-warning? #t) - (log-line "WARNING: per-session memory limit not supported by MrEd"))]) - (custodian-limit-memory session-cust - (get-conf 'session-memory-limit) - session-cust))) - (let ([watcher - (parameterize ([current-custodian orig-custodian]) + (define session-cust (make-custodian)) + (define session-channel (make-channel)) + (define timeout #f) + (define status-box (box #f)) + (define (watch-loop timed-out?) + (cond [(sync/timeout 3 session-thread) + (let* ([status (unbox status-box)] + [status (if status (format " while ~a" status) "")]) + (log-line "session killed ~a~a" + (if timed-out? "(timeout) " "(memory)") + status) + (write+flush + w (format "handin terminated due to ~a ~a~a" + (if timed-out? "time limit" "excessive memory use") + "(program doesn't terminate?)" + status)) + (close-output-port w) + (channel-put session-channel 'done))] + [(let ([t timeout]) ; grab value to avoid races + (and t ((current-inexact-milliseconds) . > . t))) + ;; Shutdown here to get the handin-terminated error + ;; message, instead of relying on a timeout at the + ;; run-server level + (custodian-shutdown-all session-cust) + (watch-loop #t)] + [else (collect-garbage) + (log-line "running ~a ~a" + (current-memory-use session-cust) + (if no-limit-warning? + "(total)" + (list (current-memory-use orig-custodian) + (current-memory-use)))) + (watch-loop #f)])) + (define (timeout-control msg) + (if (rational? msg) + (set! timeout (+ (current-inexact-milliseconds) (* 1000 msg))) + (case msg + [(reset) (timeout-control (get-conf 'session-timeout))] + [(disable) (set! timeout #f)] + [else (error 'timeout-control "bad argument: ~s" msg)]))) + (current-timeout-control timeout-control) + (timeout-control 'reset) + (unless no-limit-warning? + (with-handlers ([exn:fail:unsupported? + (lambda (x) + (set! no-limit-warning? #t) + (log-line "WARNING: per-session memory limit ~a" + "not supported by MrEd"))]) + (custodian-limit-memory + session-cust (get-conf 'session-memory-limit) session-cust))) + (let ([watcher + (parameterize ([current-custodian orig-custodian]) + (thread + (lambda () + (let ([session-thread (channel-get session-channel)]) + (watch-loop #f)))))]) + ;; Run proc in a thread under session-cust: + (let ([session-thread + (parameterize ([current-custodian session-cust] + [current-run-status-box status-box]) (thread (lambda () - (let ([session-thread (channel-get session-channel)]) - (let loop ([timed-out? #f]) - (cond - [(sync/timeout 3 session-thread) - (let* ([status (unbox status-box)] - [status (if status - (format " while ~a" status) - "")]) - (log-line "session killed ~a~a" - (if timed-out? "(timeout) " "(memory)") - status) - (write+flush - w (format "handin terminated due to ~a (program doesn't terminate?)~a" - (if timed-out? "time limit" "excessive memory use") - status)) - (close-output-port w) - (channel-put session-channel 'done))] - [(let ([t timeout]) ; grab value to avoid races - (and t ((current-inexact-milliseconds) . > . t))) - ;; Shutdown here to get the handin-terminated error - ;; message, instead of relying on a timeout at the - ;; run-server level - (custodian-shutdown-all session-cust) - (loop #t)] - [else - (collect-garbage) - (log-line "running ~a ~a" - (current-memory-use session-cust) - (if no-limit-warning? - "(total)" - (list (current-memory-use orig-custodian) - (current-memory-use)))) - (loop #f)]))))))]) - ;; Run proc in a thread under session-cust: - (let ([session-thread - (parameterize ([current-custodian session-cust] - [current-run-status-box status-box]) - (thread - (lambda () - (proc (lambda () - ;; Proc has succeeded... - (parameterize ([current-custodian orig-custodian]) - (kill-thread watcher)))) - (channel-put session-channel 'done-normal))))]) - (channel-put session-channel session-thread) - ;; Wait until the proc is done or killed (and kill is reported): - (channel-get session-channel))))) + (proc (lambda () + ;; Proc has succeeded... + (parameterize ([current-custodian orig-custodian]) + (kill-thread watcher)))) + (channel-put session-channel 'done-normal))))]) + (channel-put session-channel session-thread) + ;; Wait until the proc is done or killed (and kill is reported): + (channel-get session-channel)))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/collects/mzlib/private/unit-compiletime.ss b/collects/mzlib/private/unit-compiletime.ss index f7043eded6..1cbb60ca16 100644 --- a/collects/mzlib/private/unit-compiletime.ss +++ b/collects/mzlib/private/unit-compiletime.ss @@ -9,18 +9,18 @@ (require scheme/private/define-struct) (provide (struct var-info (syntax? exported? id)) - (struct signature (siginfo vars val-defs stx-defs)) + (struct signature (siginfo vars val-defs stx-defs orig-binder)) (rename build-siginfo make-siginfo) siginfo-names siginfo-ctime-ids siginfo-rtime-ids siginfo-subtype (struct signature-form (f)) - (struct unit-info (unit-id import-sig-ids export-sig-ids)) + (struct unit-info (unit-id import-sig-ids export-sig-ids orig-binder)) (struct link-record (linkid tag sigid siginfo)) unprocess-link-record-bind unprocess-link-record-use set!-trans-extract do-identifier process-tagged-import process-tagged-export lookup-signature lookup-def-unit make-id-mapper make-id-mappers sig-names sig-int-names sig-ext-names map-sig split-requires apply-mac complete-exports complete-imports check-duplicate-subs - process-spec process-spec2) + process-spec) (define-syntax (apply-mac stx) (syntax-case stx () @@ -101,8 +101,9 @@ ;; (make-signature siginfo ;; (listof identifier) ;; (listof (cons (listof identifier) syntax-object)) - ;; (listof (cons (listof identifier) syntax-object))) - (define-struct/proc signature (siginfo vars val-defs stx-defs) + ;; (listof (cons (listof identifier) syntax-object)) + ;; identifier) + (define-struct/proc signature (siginfo vars val-defs stx-defs orig-binder) (lambda (_ stx) (parameterize ((error-syntax stx)) (raise-stx-err "illegal use of signature name")))) @@ -113,8 +114,8 @@ (parameterize ((error-syntax stx)) (raise-stx-err "illegal use of signature form")))) - ;; (make-unit-info identifier (listof (cons symbol identifier)) (listof (cons symbol identifier))) - (define-struct/proc unit-info (unit-id import-sig-ids export-sig-ids deps) + ;; (make-unit-info identifier (listof (cons symbol identifier)) (listof (cons symbol identifier)) identifier) + (define-struct/proc unit-info (unit-id import-sig-ids export-sig-ids deps orig-binder) (lambda (struct stx) (with-syntax ((u (unit-info-unit-id struct))) (syntax-case stx (set!) @@ -223,13 +224,22 @@ sig))) ;; do-identifier : identifier (box (cons identifier siginfo)) -> sig - (define (do-identifier spec res) + (define (do-identifier spec res bind?) (let* ((sig (lookup-signature spec)) (vars (signature-vars sig)) (vals (signature-val-defs sig)) - (stxs (signature-stx-defs sig))) + (stxs (signature-stx-defs sig)) + (delta-introduce (if bind? + (let ([f (make-syntax-delta-introducer + spec + (signature-orig-binder sig))]) + (lambda (id) (syntax-local-introduce (f id)))) + values))) (set-box! res (cons spec (signature-siginfo sig))) - (map-sig intro-o-shadow + (map-sig (lambda (id) + (syntax-local-introduce + (syntax-local-get-shadower + (delta-introduce id)))) syntax-local-introduce (list (map cons vars vars) (map @@ -257,10 +267,6 @@ (define (sig-ext-names sig) (map cdr (sig-names sig))) - ;; intro-o-shadow : identifier -> identifier - (define (intro-o-shadow id) - (syntax-local-introduce (syntax-local-get-shadower id))) - ;; map-def : (identifier -> identifier) (syntax-object -> syntax-object) def -> def (define (map-def f g def) (cons (map (lambda (x) @@ -297,46 +303,46 @@ ;; process-tagged-import/export : syntax-object boolean -> tagged-sig - (define (process-tagged-import/export spec import?) + (define (process-tagged-import/export spec import? bind?) (define res (box #f)) (check-tagged-spec-syntax spec import? identifier?) (syntax-case spec (tag) ((tag sym spec) - (let ([s (process-import/export #'spec res)]) + (let ([s (process-import/export #'spec res bind?)]) (list (cons (syntax-e #'sym) (cdr (unbox res))) (cons (syntax-e #'sym) (car (unbox res))) s))) ((tag . _) (raise-stx-err "expected (tag symbol )" spec)) - (_ (let ([s (process-import/export spec res)]) + (_ (let ([s (process-import/export spec res bind?)]) (list (cons #f (cdr (unbox res))) (cons #f (car (unbox res))) s))))) ;; process-import/export : syntax-object (box (cons identifier) siginfo) -> sig - (define (process-import/export spec res) + (define (process-import/export spec res bind?) (syntax-case spec (only except prefix rename) (_ (identifier? spec) - (do-identifier spec res)) + (do-identifier spec res bind?)) ((only sub-spec id ...) - (do-only/except (process-import/export #'sub-spec res) + (do-only/except (process-import/export #'sub-spec res bind?) (syntax->list #'(id ...)) (lambda (x) x) (lambda (id) (car (generate-temporaries #`(#,id)))))) ((except sub-spec id ...) - (do-only/except (process-import/export #'sub-spec res) + (do-only/except (process-import/export #'sub-spec res bind?) (syntax->list #'(id ...)) (lambda (id) (car (generate-temporaries #`(#,id)))) (lambda (x) x))) ((prefix pid sub-spec) - (do-prefix (process-import/export #'sub-spec res) #'pid)) + (do-prefix (process-import/export #'sub-spec res bind?) #'pid)) ((rename sub-spec (internal external) ...) (let* ((sig-res - (do-rename (process-import/export #'sub-spec res) + (do-rename (process-import/export #'sub-spec res bind?) #'(internal ...) #'(external ...))) (dup (check-duplicate-identifier (sig-int-names sig-res)))) @@ -347,21 +353,14 @@ sig-res)))) (define (process-tagged-import spec) - (process-tagged-import/export spec #t)) + (process-tagged-import/export spec #t #t)) (define (process-tagged-export spec) - (process-tagged-import/export spec #f)) + (process-tagged-import/export spec #f #t)) ;; process-spec : syntax-object -> sig (define (process-spec spec) (check-tagged-spec-syntax spec #f identifier?) - (process-import/export spec (box #f))) - - ;; process-spec2 : syntax-object -> identifier? - (define (process-spec2 spec) - (define b (box #f)) - (check-tagged-spec-syntax spec #t identifier?) - (process-import/export spec b) - (car (unbox b))) + (process-import/export spec (box #f) #t)) ; ;; extract-siginfo : (union import-spec export-spec) -> ??? diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss index c38df307e8..60072b633c 100644 --- a/collects/mzlib/unit.ss +++ b/collects/mzlib/unit.ss @@ -221,7 +221,8 @@ (list (cons (list (quote-syntax sid) ...) ((syntax-local-certifier) (quote-syntax sbody))) - ...)))))))) + ...) + (quote-syntax #,sigid)))))))) (else (syntax-case (car sig-exprs) (define-values define-syntaxes) (x @@ -1274,7 +1275,8 @@ (make-unit-info ((syntax-local-certifier) (quote-syntax u)) (list (cons 'itag (quote-syntax isig)) ...) (list (cons 'etag (quote-syntax esig)) ...) - (list (cons 'deptag (quote-syntax deptag)) ...)))))))))) + (list (cons 'deptag (quote-syntax deptag)) ...) + (quote-syntax name)))))))))) ((_) (raise-stx-err err-msg)))) @@ -1356,9 +1358,12 @@ (define-syntax/err-param (define-values/invoke-unit/infer stx) (syntax-case stx () ((_ u) - (let ((ui (lookup-def-unit #'u))) - (with-syntax (((sig ...) (map unprocess-tagged-id (unit-info-export-sig-ids ui))) - ((isig ...) (map unprocess-tagged-id (unit-info-import-sig-ids ui)))) + (let* ((ui (lookup-def-unit #'u)) + (unprocess (let ([i (make-syntax-delta-introducer #'u (unit-info-orig-binder ui))]) + (lambda (p) + (unprocess-tagged-id (cons (car p) (i (cdr p)))))))) + (with-syntax (((sig ...) (map unprocess (unit-info-export-sig-ids ui))) + ((isig ...) (map unprocess (unit-info-import-sig-ids ui)))) (quasisyntax/loc stx (define-values/invoke-unit u (import isig ...) (export sig ...)))))) ((_) @@ -1437,19 +1442,23 @@ s)) (apply make-link-record l)) - (define (process-tagged-sigid sid) - (make-link-record (car sid) #f (cdr sid) (signature-siginfo (lookup-signature (cdr sid))))) + (define ((process-tagged-sigid introducer) sid) + (make-link-record (car sid) #f (introducer (cdr sid)) (signature-siginfo (lookup-signature (cdr sid))))) (syntax-case stx () (((import ...) (export ...) (((out ...) u l ...) ...)) - (let* ([units (map lookup-def-unit (syntax->list #'(u ...)))] + (let* ([us (syntax->list #'(u ...))] + [units (map lookup-def-unit us)] [import-sigs (map process-signature (syntax->list #'(import ...)))] + [sig-introducers (map (lambda (unit u) + (make-syntax-delta-introducer u (unit-info-orig-binder unit))) + units us)] [sub-outs (map - (lambda (outs unit) + (lambda (outs unit sig-introducer) (define o (map (lambda (clause) @@ -1457,10 +1466,11 @@ (make-link-record (car c) (cadr c) (cddr c) (signature-siginfo (lookup-signature (cddr c))))) (syntax->list outs))) - (complete-exports (map process-tagged-sigid (unit-info-export-sig-ids unit)) + (complete-exports (map (process-tagged-sigid sig-introducer) (unit-info-export-sig-ids unit)) o)) (syntax->list #'((out ...) ...)) - units)] + units + sig-introducers)] [link-defs (append import-sigs (apply append sub-outs))]) (define lnk-table (make-bound-identifier-mapping)) @@ -1486,7 +1496,7 @@ (let ([sub-ins (map - (lambda (ins unit unit-stx) + (lambda (ins unit sig-introducer unit-stx) (define is (syntax->list ins)) (define lrs (map @@ -1510,12 +1520,13 @@ is) (complete-imports sig-table lrs - (map process-tagged-sigid + (map (process-tagged-sigid sig-introducer) (unit-info-import-sig-ids unit)) unit-stx)) (syntax->list #'((l ...) ...)) units - (syntax->list #'(u ...)))] + sig-introducers + us)] [exports (map (lambda (e) diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index 906b5db5dd..b53bd5b766 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "13oct2008") +#lang scheme/base (provide stamp) (define stamp "16oct2008") diff --git a/collects/scheme/private/contract-ds.ss b/collects/scheme/private/contract-ds.ss index 0056d9a9aa..a3659cc3ce 100644 --- a/collects/scheme/private/contract-ds.ss +++ b/collects/scheme/private/contract-ds.ss @@ -467,12 +467,12 @@ it around flattened out. (define (do-contract-name name/c name/dc list-of-subcontracts fields attrs) (cond - [(and (andmap contract? list-of-subcontracts) (not attrs)) + [(and (andmap name-pred? list-of-subcontracts) (not attrs)) (apply build-compound-type-name name/c list-of-subcontracts)] [else (let ([fields (map (λ (field ctc) - (if (contract? ctc) + (if (name-pred? ctc) (build-compound-type-name field ctc) (build-compound-type-name field '...))) fields diff --git a/collects/scheme/private/contract-guts.ss b/collects/scheme/private/contract-guts.ss index ca1d8914d0..15d47e6950 100644 --- a/collects/scheme/private/contract-guts.ss +++ b/collects/scheme/private/contract-guts.ss @@ -143,7 +143,7 @@ ;; returns #f if the argument could not be coerced to a contract (define (coerce-contract/f x) (cond - [(contract? x) x] + [(proj-pred? x) x] [(and (procedure? x) (procedure-arity-includes? x 1)) (make-predicate-contract (or (object-name x) '???) x)] [(or (symbol? x) (boolean? x) (char? x) (null? x)) (make-eq-contract x)] @@ -363,7 +363,7 @@ (let ([ctc (coerce-contract 'contract-name ctc)]) ((name-get ctc) ctc))) -(define (contract? x) (proj-pred? x)) +(define (contract? x) (and (coerce-contract/f x) #t)) (define (contract-proc ctc) ((proj-get ctc) ctc)) (define (check-flat-contract predicate) (coerce-flat-contract 'flat-contract predicate)) @@ -381,7 +381,7 @@ '()] [else (let ([sub (car subs)]) (cond - [(contract? sub) + [(name-pred? sub) (let ([mk-sub-name (contract-name sub)]) `(,mk-sub-name ,@(loop (cdr subs))))] [else `(,sub ,@(loop (cdr subs)))]))]))) diff --git a/collects/scheme/private/contract.ss b/collects/scheme/private/contract.ss index eb5cf11a52..acff2e0640 100644 --- a/collects/scheme/private/contract.ss +++ b/collects/scheme/private/contract.ss @@ -948,17 +948,12 @@ improve method arity mismatch contract violation error messages? (syntax (make-proj-contract '(recursive-contract arg) (λ (pos-blame neg-blame src str) - (let ([proc (contract-proc arg)]) - (λ (val) - ((proc pos-blame neg-blame src str) val)))) + (let ([ctc (coerce-contract 'recursive-contract arg)]) + (let ([proc (contract-proc ctc)]) + (λ (val) + ((proc pos-blame neg-blame src str) val))))) #f))])) -(define (check-contract ctc) - (unless (contract? ctc) - (error 'recursive-contract "expected a contract, got ~e" ctc)) - ctc) - - ; ; ; diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index a926c89fd6..b248d5dfb4 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -12,7 +12,9 @@ scheme/stxparam scheme/serialize setup/main-collects - (for-syntax scheme/base) + (for-syntax scheme/base + syntax/boundmap + syntax/kerncase) (for-label scheme/base scheme/class)) @@ -739,13 +741,16 @@ [(_ [[proto result] ...] desc ...) (defproc* #:mode procedure #:within #f [[proto result] ...] desc ...)] [(_ #:mode m #:within cl [[proto result] ...] desc ...) - (*defproc 'm (quote-syntax/loc cl) - (list (extract-proc-id proto) ...) - '[proto ...] - (list (arg-contracts proto) ...) - (list (arg-defaults proto) ...) - (list (lambda () (result-contract result)) ...) - (lambda () (list desc ...)))])) + (with-togetherable-scheme-variables + () + ([proc proto] ...) + (*defproc 'm (quote-syntax/loc cl) + (list (extract-proc-id proto) ...) + '[proto ...] + (list (arg-contracts proto) ...) + (list (arg-defaults proto) ...) + (list (lambda () (result-contract result)) ...) + (lambda () (list desc ...))))])) (define-syntax defstruct (syntax-rules () [(_ name fields #:mutable #:inspector #f desc ...) @@ -762,10 +767,13 @@ (**defstruct name fields #t #f desc ...)])) (define-syntax-rule (**defstruct name ([field field-contract] ...) immutable? transparent? desc ...) - (*defstruct (quote-syntax/loc name) 'name - '([field field-contract] ...) - (list (lambda () (schemeblock0 field-contract)) ...) - immutable? transparent? (lambda () (list desc ...)))) + (with-togetherable-scheme-variables + () + () + (*defstruct (quote-syntax/loc name) 'name + '([field field-contract] ...) + (list (lambda () (schemeblock0 field-contract)) ...) + immutable? transparent? (lambda () (list desc ...))))) (define-syntax (defform*/subs stx) (syntax-case stx () [(_ #:id defined-id #:literals (lit ...) [spec spec1 ...] @@ -783,16 +791,20 @@ spec spec)] [_ spec])))]) - #'(*defforms (quote-syntax/loc defined-id) '(lit ...) - '(spec spec1 ...) - (list (lambda (x) (schemeblock0/form new-spec)) - (lambda (ignored) (schemeblock0/form spec1)) ...) - '((non-term-id non-term-form ...) ...) - (list (list (lambda () (scheme non-term-id)) - (lambda () (schemeblock0/form non-term-form)) - ...) - ...) - (lambda () (list desc ...))))] + #'(with-togetherable-scheme-variables + (lit ...) + ([form spec] [form spec1] ... + [non-term (non-term-id non-term-form ...)] ...) + (*defforms (quote-syntax/loc defined-id) + '(spec spec1 ...) + (list (lambda (x) (schemeblock0/form new-spec)) + (lambda (ignored) (schemeblock0/form spec1)) ...) + '((non-term-id non-term-form ...) ...) + (list (list (lambda () (scheme non-term-id)) + (lambda () (schemeblock0/form non-term-form)) + ...) + ...) + (lambda () (list desc ...)))))] [(fm #:id id [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...) #'(fm #:id id #:literals () [spec spec1 ...] @@ -839,46 +851,60 @@ (define-syntax (defform/none stx) (syntax-case stx () [(_ #:literals (lit ...) spec desc ...) - #'(*defforms #f '(lit ...) - '(spec) (list (lambda (ignored) (schemeblock0/form spec))) - null null - (lambda () (list desc ...)))] + #'(with-togetherable-scheme-variables + (lit ...) + ([form spec]) + (*defforms #f + '(spec) (list (lambda (ignored) (schemeblock0/form spec))) + null null + (lambda () (list desc ...))))] [(_ spec desc ...) #'(defform/none #:literals () spec desc ...)])) (define-syntax (defidform stx) (syntax-case stx () [(_ spec-id desc ...) - #'(*defforms (quote-syntax/loc spec-id) null - '(spec-id) - (list (lambda (x) (make-omitable-paragraph (list x)))) - null - null - (lambda () (list desc ...)))])) + #'(with-togetherable-scheme-variables + () + () + (*defforms (quote-syntax/loc spec-id) + '(spec-id) + (list (lambda (x) (make-omitable-paragraph (list x)))) + null + null + (lambda () (list desc ...))))])) (define-syntax (defsubform stx) (syntax-case stx () [(_ . rest) #'(into-blockquote (defform . rest))])) (define-syntax (defsubform* stx) (syntax-case stx () [(_ . rest) #'(into-blockquote (defform* . rest))])) +(define-syntax spec?form/subs + (syntax-rules () + [(_ has-kw? #:literals (lit ...) spec ([non-term-id non-term-form ...] ...) + desc ...) + (with-scheme-variables + (lit ...) + ([form/maybe (has-kw? spec)] + [non-term (non-term-id non-term-form ...)] ...) + (*specsubform 'spec '(lit ...) (lambda () (schemeblock0/form spec)) + '((non-term-id non-term-form ...) ...) + (list (list (lambda () (scheme non-term-id)) + (lambda () (schemeblock0/form non-term-form)) + ...) + ...) + (lambda () (list desc ...))))])) (define-syntax specsubform (syntax-rules () [(_ #:literals (lit ...) spec desc ...) - (*specsubform 'spec #f '(lit ...) (lambda () (schemeblock0/form spec)) - null null (lambda () (list desc ...)))] + (spec?form/subs #f #:literals (lit ...) spec () desc ...)] [(_ spec desc ...) - (*specsubform 'spec #f null (lambda () (schemeblock0/form spec)) - null null (lambda () (list desc ...)))])) + (specsubform #:literals () spec desc ...)])) (define-syntax specsubform/subs (syntax-rules () [(_ #:literals (lit ...) spec ([non-term-id non-term-form ...] ...) desc ...) - (*specsubform 'spec #f '(lit ...) (lambda () (schemeblock0/form spec)) - '((non-term-id non-term-form ...) ...) - (list (list (lambda () (scheme non-term-id)) - (lambda () (schemeblock0/form non-term-form)) - ...) - ...) - (lambda () (list desc ...)))] + (spec?form/subs #f #:literals (lit ...) spec ([non-term-id non-term-form ...] ...) + desc ...)] [(_ spec subs desc ...) (specsubform/subs #:literals () spec subs desc ...)])) (define-syntax-rule (specspecsubform spec desc ...) @@ -888,37 +914,37 @@ (define-syntax specform (syntax-rules () [(_ #:literals (lit ...) spec desc ...) - (*specsubform 'spec #t '(lit ...) (lambda () (schemeblock0/form spec)) - null null (lambda () (list desc ...)))] + (spec?form/subs #t #:literals (lit ...) spec () desc ...)] [(_ spec desc ...) - (*specsubform 'spec #t null (lambda () (schemeblock0/form spec)) - null null (lambda () (list desc ...)))])) + (specform #:literals () spec desc ...)])) (define-syntax specform/subs (syntax-rules () [(_ #:literals (lit ...) spec ([non-term-id non-term-form ...] ...) desc ...) - (*specsubform 'spec #t - '(lit ...) - (lambda () (schemeblock0/form spec)) - '((non-term-id non-term-form ...) ...) - (list (list (lambda () (scheme non-term-id)) - (lambda () (schemeblock0/form non-term-form)) - ...) - ...) - (lambda () (list desc ...)))] + (spec?form/subs #t #:literals (lit ...) spec ([non-term-id non-term-form ...] ...) + desc ...)] [(_ spec ([non-term-id non-term-form ...] ...) desc ...) (specform/subs #:literals () spec ([non-term-id non-term-form ...] ...) desc ...)])) (define-syntax-rule (specsubform/inline spec desc ...) - (*specsubform 'spec #f null #f null null (lambda () (list desc ...)))) + (with-scheme-variables + () + ([form/maybe (#f spec)]) + (*specsubform 'spec null #f null null (lambda () (list desc ...))))) (define-syntax-rule (defthing id result desc ...) - (*defthing (list (quote-syntax/loc id)) (list 'id) #f - (list (schemeblock0 result)) - (lambda () (list desc ...)))) + (with-togetherable-scheme-variables + () + () + (*defthing (list (quote-syntax/loc id)) (list 'id) #f + (list (schemeblock0 result)) + (lambda () (list desc ...))))) (define-syntax-rule (defthing* ([id result] ...) desc ...) - (*defthing (list (quote-syntax/loc id) ...) (list 'id ...) #f - (list (schemeblock0 result) ...) - (lambda () (list desc ...)))) + (with-togetherable-scheme-variables + () + () + (*defthing (list (quote-syntax/loc id) ...) (list 'id ...) #f + (list (schemeblock0 result) ...) + (lambda () (list desc ...))))) (define-syntax-rule (defparam id arg contract desc ...) (defproc* ([(id) contract] [(id [arg contract]) void?]) desc ...)) (define-syntax-rule (defparam* id arg in-contract out-contract desc ...) @@ -928,20 +954,26 @@ (define-syntax schemegrammar (syntax-rules () [(_ #:literals (lit ...) id clause ...) - (*schemegrammar '(lit ...) - '(id clause ...) - (lambda () - (list (list (scheme id) - (schemeblock0/form clause) ...))))] + (with-scheme-variables + (lit ...) + ([non-term (id clause ...)]) + (*schemegrammar '(lit ...) + '(id clause ...) + (lambda () + (list (list (scheme id) + (schemeblock0/form clause) ...)))))] [(_ id clause ...) (schemegrammar #:literals () id clause ...)])) (define-syntax schemegrammar* (syntax-rules () [(_ #:literals (lit ...) [id clause ...] ...) - (*schemegrammar '(lit ...) - '(id ... clause ... ...) - (lambda () - (list (list (scheme id) (schemeblock0/form clause) ...) - ...)))] + (with-scheme-variables + (lit ...) + ([non-term (id clause ...)] ...) + (*schemegrammar '(lit ...) + '(id ... clause ... ...) + (lambda () + (list (list (scheme id) (schemeblock0/form clause) ...) + ...))))] [(_ [id clause ...] ...) (schemegrammar* #:literals () [id clause ...] ...)])) (define-syntax-rule (var id) @@ -949,6 +981,75 @@ (define-syntax-rule (svar id) (*var 'id)) +(define-syntax (with-togetherable-scheme-variables stx) + (syntax-case stx () + [(_ . rest) + ;; Make it transparent, so deftogether is allowed to pull it apart + (syntax-property + (syntax/loc stx + (with-togetherable-scheme-variables* . rest)) + 'certify-mode + 'transparent)])) + +(define-syntax-rule (with-togetherable-scheme-variables* . rest) + (with-scheme-variables . rest)) + +(define-syntax (with-scheme-variables stx) + (syntax-case stx () + [(_ lits ([kind s-exp] ...) body) + (let ([ht (make-bound-identifier-mapping)] + [lits (syntax->datum #'lits)]) + (for-each (lambda (kind s-exp) + (case (syntax-e kind) + [(proc) + (for-each + (lambda (arg) + (if (identifier? arg) + (unless (or (eq? (syntax-e arg) '...) + (eq? (syntax-e arg) '...+) + (memq (syntax-e arg) lits)) + (bound-identifier-mapping-put! ht arg #t)) + (syntax-case arg () + [(kw arg . rest) + (keyword? (syntax-e #'kw)) + (bound-identifier-mapping-put! ht #'arg #t)] + [(arg . rest) + (identifier? #'arg) + (bound-identifier-mapping-put! ht #'arg #t)]))) + (cdr (syntax->list s-exp)))] + [(form form/maybe non-term) + (let loop ([form (case (syntax-e kind) + [(form) (if (identifier? s-exp) + null + (cdr (syntax-e s-exp)))] + [(form/maybe) + (syntax-case s-exp () + [(#f form) #'form] + [(#t (id . form)) #'form])] + [(non-term) s-exp])]) + (if (identifier? form) + (unless (or (eq? (syntax-e form) '...) + (eq? (syntax-e form) '...+) + (eq? (syntax-e form) '?) + (memq (syntax-e form) lits)) + (bound-identifier-mapping-put! ht form #t)) + (syntax-case form (unsyntax) + [(unsyntax _) (void)] + [(a . b) (loop #'a) (loop #'b)] + [#(a ...) (loop #'(a ...))] + [_ (void)])))] + [else + (raise-syntax-error + #f + "unknown variable mode" + stx + kind)])) + (syntax->list #'(kind ...)) + (syntax->list #'(s-exp ...))) + (with-syntax ([(id ...) (bound-identifier-mapping-map ht (lambda (k v) k))]) + #'(parameterize ([current-variable-list '(id ...)]) + body)))])) + (define (defthing/proc id contract descs) (*defthing (list id) (list (syntax-e id)) #f (list contract) (lambda () descs))) @@ -1009,7 +1110,7 @@ (lambda (render part ri) (proc (or (get-exporting-libraries render part ri) null))))) -(define-struct (box-splice splice) (var-list)) +(define-struct (box-splice splice) ()) (define (*deftogether boxes body-thunk) (make-splice @@ -1029,12 +1130,33 @@ "together" (table-flowss (car (splice-run box)))))))) boxes)) - (parameterize ([current-variable-list - (append-map box-splice-var-list boxes)]) - (body-thunk))))) + (body-thunk)))) -(define-syntax-rule (deftogether (box ...) . body) - (*deftogether (list box ...) (lambda () (list . body)))) +(define-syntax (deftogether stx) + (syntax-case stx () + [(_ (def ...) . body) + (with-syntax ([((_ (lit ...) (var ...) decl) ...) + (map (lambda (def) + (let ([exp-def (local-expand + def + 'expression + (cons + #'with-togetherable-scheme-variables* + (kernel-form-identifier-list)))]) + (syntax-case exp-def (with-togetherable-scheme-variables*) + [(with-togetherable-scheme-variables* lits vars decl) + exp-def] + [_ + (raise-syntax-error + #f + "sub-form is not a documentation form that can be combined" + stx + def)]))) + (syntax->list #'(def ...)))]) + #'(with-togetherable-scheme-variables + (lit ... ...) + (var ... ...) + (*deftogether (list decl ...) (lambda () (list . body)))))])) (define-struct arg (special? kw id optional? starts-optional? ends-optional? num-closers)) @@ -1365,22 +1487,20 @@ (define var-list (filter-map (lambda (a) (and (not (arg-special? a)) (arg-id a))) (append* all-args))) - (parameterize ([current-variable-list var-list]) - (make-box-splice - (cons - (make-table - 'boxed - (append-map - do-one - stx-ids prototypes all-args arg-contractss arg-valss result-contracts - (let loop ([ps prototypes] [accum null]) - (cond [(null? ps) null] - [(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum) - (cons #f (loop (cdr ps) accum))] - [else (cons #t (loop (cdr ps) - (cons (extract-id (car ps)) accum)))])))) - (content-thunk)) - var-list))) + (make-box-splice + (cons + (make-table + 'boxed + (append-map + do-one + stx-ids prototypes all-args arg-contractss arg-valss result-contracts + (let loop ([ps prototypes] [accum null]) + (cond [(null? ps) null] + [(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum) + (cons #f (loop (cdr ps) accum))] + [else (cons #t (loop (cdr ps) + (cons (extract-id (car ps)) accum)))])))) + (content-thunk)))) (define (make-target-element* inner-make-target-element stx-id content wrappers) (if (null? wrappers) @@ -1577,8 +1697,7 @@ (make-flow (list (field-contract))))))))] [else null])) fields field-contracts))) - (content-thunk)) - null)) + (content-thunk)))) (define (*defthing stx-ids names form? result-contracts content-thunk) (make-box-splice @@ -1623,24 +1742,12 @@ result-contract (make-omitable-paragraph (list result-contract))))))))))) stx-ids names result-contracts)) - (content-thunk)) - null)) + (content-thunk)))) (define (meta-symbol? s) (memq s '(... ...+ ?))) -(define (*defforms kw-id lits forms form-procs subs sub-procs content-thunk) - (define var-list - (let loop ([form (cons forms subs)]) - (cond [(symbol? form) - (if (or (meta-symbol? form) - (and kw-id (eq? form (syntax-e kw-id))) - (memq form lits)) - null - (list form))] - [(pair? form) (append (loop (car form)) (loop (cdr form)))] - [else null]))) - (parameterize ([current-variable-list var-list] - [current-meta-list '(... ...+)]) +(define (*defforms kw-id forms form-procs subs sub-procs content-thunk) + (parameterize ([current-meta-list '(... ...+)]) (make-box-splice (cons (make-table @@ -1689,23 +1796,10 @@ (*schemerawgrammars "specgrammar" (map car l) (map cdr l)))))))))) - (content-thunk)) - var-list))) + (content-thunk))))) -(define (*specsubform form has-kw? lits form-thunk subs sub-procs content-thunk) - (parameterize ([current-variable-list - (append (let loop ([form (cons (if has-kw? (cdr form) form) - subs)]) - (cond - [(symbol? form) (if (or (meta-symbol? form) - (memq form lits)) - null - (list form))] - [(pair? form) (append (loop (car form)) - (loop (cdr form)))] - [else null])) - (current-variable-list))] - [current-meta-list '(... ...+)]) +(define (*specsubform form lits form-thunk subs sub-procs content-thunk) + (parameterize ([current-meta-list '(... ...+)]) (make-blockquote "leftindent" (cons @@ -1754,23 +1848,14 @@ (*schemerawgrammars style (list nonterm) (list (cons clause1 clauses)))) (define (*schemegrammar lits s-expr clauseses-thunk) - (parameterize ([current-variable-list - (let loop ([form s-expr]) - (cond - [(symbol? form) (if (memq form lits) - null - (list form))] - [(pair? form) (append (loop (car form)) - (loop (cdr form)))] - [else null]))]) - (let ([l (clauseses-thunk)]) - (*schemerawgrammars #f - (map (lambda (x) - (make-element #f - (list (hspace 2) - (car x)))) - l) - (map cdr l))))) + (let ([l (clauseses-thunk)]) + (*schemerawgrammars #f + (map (lambda (x) + (make-element #f + (list (hspace 2) + (car x)))) + l) + (map cdr l)))) (define (*var id) (to-element (*var-sym id))) @@ -2425,16 +2510,22 @@ signature-desc) (define-syntax-rule (defsignature name (super ...) body ...) - (*defsignature (quote-syntax name) - (list (quote-syntax super) ...) - (lambda () (list body ...)) - #t)) + (with-togetherable-scheme-variables + () + () + (*defsignature (quote-syntax name) + (list (quote-syntax super) ...) + (lambda () (list body ...)) + #t))) (define-syntax-rule (defsignature/splice name (super ...) body ...) - (*defsignature (quote-syntax name) - (list (quote-syntax super) ...) - (lambda () (list body ...)) - #f)) + (with-togetherable-scheme-variables + () + () + (*defsignature (quote-syntax name) + (list (quote-syntax super) ...) + (lambda () (list body ...)) + #f))) (define-struct sig-desc (in)) (define (signature-desc . l) diff --git a/collects/scribblings/gui/bitmap-class.scrbl b/collects/scribblings/gui/bitmap-class.scrbl index 6e4f8a350a..d9ca931bde 100644 --- a/collects/scribblings/gui/bitmap-class.scrbl +++ b/collects/scribblings/gui/bitmap-class.scrbl @@ -25,7 +25,7 @@ Sometimes, a bitmap object creation fails in a low-level manner. In [width (integer-in 1 10000)] [height (integer-in 1 10000)]))]{ -When @scheme[with] and @scheme[height] are provided: Creates a new +When @scheme[width] and @scheme[height] are provided: Creates a new bitmap. If @scheme[monochrome?] is @scheme[#f], the bitmap matches the display depth of the screen. The initial content of the bitmap is undefined. diff --git a/collects/scribblings/guide/for.scrbl b/collects/scribblings/guide/for.scrbl index 2d5cdce9d6..29fe2b9349 100644 --- a/collects/scribblings/guide/for.scrbl +++ b/collects/scribblings/guide/for.scrbl @@ -391,7 +391,7 @@ fast-clause [id fast-seq] ] @schemegrammar[ -#:literals [in-range in-naturals in-list in-vector in-string in-bytes stop-before stop-after] +#:literals [in-range in-naturals in-list in-vector in-string in-bytes in-value stop-before stop-after] fast-seq (in-range expr expr) (in-range expr expr expr) (in-naturals) diff --git a/collects/scribblings/guide/pattern-macros.scrbl b/collects/scribblings/guide/pattern-macros.scrbl index 3b41fe35b7..ae3f087a9e 100644 --- a/collects/scribblings/guide/pattern-macros.scrbl +++ b/collects/scribblings/guide/pattern-macros.scrbl @@ -144,7 +144,8 @@ such macros, the programmer much use the more general @scheme[define-syntax] form along with the @scheme[syntax-rules] transformer form: -@specform[(define-syntax id +@specform[#:literals (syntax-rules) + (define-syntax id (syntax-rules (literal-id ...) [pattern template] ...))] @@ -260,7 +261,8 @@ clock 3)] expands to @scheme[(put-clock! 3)]. The @scheme[syntax-id-rules] form is like @scheme[syntax-rules], but it creates a transformer that acts as an identifier macro: -@specform[(define-syntax id +@specform[#:literals (syntax-id-rules) + (define-syntax id (syntax-id-rules (literal-id ...) [pattern template] ...))] diff --git a/collects/scribblings/reference/contracts.scrbl b/collects/scribblings/reference/contracts.scrbl index b647edcf03..1abbda6c57 100644 --- a/collects/scribblings/reference/contracts.scrbl +++ b/collects/scribblings/reference/contracts.scrbl @@ -310,7 +310,7 @@ checking will not terminate.} @defform[(flat-murec-contract ([id flat-contract-expr ...] ...) body ...+)]{ -A generalization of @scheme[flat-rec-contracts] for defining several +A generalization of @scheme[flat-rec-contract] for defining several mutually recursive flat contracts simultaneously. Each @scheme[id] is visible in the entire @scheme[flat-murec-contract] form, and the result of the final @scheme[body] is the result of the entire form.} @@ -1045,9 +1045,9 @@ raised by the contract system.} @defproc[(contract? [v any/c]) boolean?]{ -Returns @scheme[#t] if its argument is a contract (ie, constructed -with one of the combinators described in this section), @scheme[#f] -otherwise.} +Returns @scheme[#t] if its argument is a contract (i.e., constructed +with one of the combinators described in this section or a value that +can be used as a contract) and @scheme[#f] otherwise.} @defproc[(flat-contract? [v any/c]) boolean?]{ diff --git a/collects/scribblings/reference/stx-trans.scrbl b/collects/scribblings/reference/stx-trans.scrbl index 9b25819288..4ef99b1666 100644 --- a/collects/scribblings/reference/stx-trans.scrbl +++ b/collects/scribblings/reference/stx-trans.scrbl @@ -440,6 +440,20 @@ mark}. Multiple applications of the same @scheme[make-syntax-introducer] result procedure use the same mark, and different result procedures use distinct marks.} +@defproc[(make-syntax-delta-introducer [ext-stx syntax?] [base-stx syntax?]) + (syntax? . -> . syntax?)]{ + +Produces a procedure that behaves like +@scheme[syntax-local-introduce], but using the @tech{syntax +marks} of @scheme[ext-stx] that are not shared with @scheme[base-stx]. + +This procedure is useful when @scheme[_m-id] has a transformer binding +that records some @scheme[_orig-id], and a use of @scheme[_m-id] +introduces a binding of @scheme[_orig-id]. In that case, the +@tech{syntax marks} in the use of @scheme[_m-id] since the binding of +@scheme[_m-id] should be transferred to the binding instance of +@scheme[_orig-id], so that it captures uses with the same lexical +context as the use of @scheme[_m-id].} @defproc[(syntax-local-transforming-module-provides?) boolean?]{ diff --git a/collects/scribblings/reference/time.scrbl b/collects/scribblings/reference/time.scrbl index 2a6f29cc0f..ac484daaa8 100644 --- a/collects/scribblings/reference/time.scrbl +++ b/collects/scribblings/reference/time.scrbl @@ -91,7 +91,7 @@ time is a portion of the time reported by @defproc[(time-apply [proc procedure?] - [arg any/c] ...) + [lst list?]) (values list? exact-integer? exact-integer? diff --git a/collects/teachpack/htdp/scribblings/image.scrbl b/collects/teachpack/htdp/scribblings/image.scrbl index 08b0f8450d..21fd8709c6 100644 --- a/collects/teachpack/htdp/scribblings/image.scrbl +++ b/collects/teachpack/htdp/scribblings/image.scrbl @@ -110,8 +110,12 @@ basic properties of images. For the composition of images, you must know about @emph{pinholes}. Each image, including primitive ones, come with a pinhole. For images created with the above primitives, the pinhole is at the center of the shape except -for those created from @scheme[line] and @scheme[text], which have pinholes -at the top left. The pinhole can be moved, of course, and compositions +for those created from @scheme[line] and @scheme[text]. +The @scheme[text] function puts the pinhole at the upper left corner of +the image, and @scheme[line] puts the pinhole at the beginning of the line +(meaning that if the first two arguments to @scheme[line] are positive, +the pinhole is also in the upper left corner). +The pinhole can be moved, of course, and compositions locate pinholes according to their own rules. When in doubt you can always find out where the pinhole is and place it where convenient. diff --git a/collects/test-engine/scheme-tests.ss b/collects/test-engine/scheme-tests.ss index 99d0382c14..6792540455 100644 --- a/collects/test-engine/scheme-tests.ss +++ b/collects/test-engine/scheme-tests.ss @@ -263,7 +263,7 @@ (define (build-test-engine) (let ([engine (make-object scheme-test%)]) - (send engine setup-info 'check-require) + (send engine setup-info 'test-check) engine)) (define (insert-test test-info test) (send test-info add-test test)) diff --git a/collects/test-engine/test-display.scm b/collects/test-engine/test-display.scm index a34d9cb0fd..8c3e5017d1 100644 --- a/collects/test-engine/test-display.scm +++ b/collects/test-engine/test-display.scm @@ -26,6 +26,27 @@ (set! drscheme-frame df) (set! src-editor ed)) + (define (docked?) + (and drscheme-frame + (get-preference 'test:test-window:docked? + (lambda () (put-preferences '(test:test-window:docked?) '(#f)) #f)))) + + (define/public (report-success) + (when current-rep + (unless current-tab + (set! current-tab (send (send current-rep get-definitions-text) get-tab))) + (unless drscheme-frame + (set! drscheme-frame (send current-rep get-top-level-window))) + (let ([curr-win (and current-tab (send current-tab get-test-window))] + [content (make-object (editor:standard-style-list-mixin text%))]) + (send this insert-test-results content test-info src-editor) + (send content lock #t) + (when curr-win (send curr-win update-editor content)) + (when current-tab (send current-tab current-test-editor content)) + (when (and curr-win (docked?)) + (send drscheme-frame display-test-panel content) + (send curr-win show #f))))) + (define/public (display-results) (let* ([curr-win (and current-tab (send current-tab get-test-window))] [window (or curr-win (make-object test-window%))] @@ -48,14 +69,9 @@ (send drscheme-frame deregister-test-window window) (send current-tab current-test-window #f) (send current-tab current-test-editor #f))))) - (if (and drscheme-frame - (get-preference 'test:test-window:docked? - (lambda () - (put-preferences '(test:test-window:docked?) - '(#f)) - #f))) - (send drscheme-frame display-test-panel content) - (send window show #t)))) + (if (docked?) + (send drscheme-frame display-test-panel content) + (send window show #t)))) (define/pubment (insert-test-results editor test-info src-editor) (let* ([style (send test-info test-style)] @@ -79,31 +95,33 @@ [(= failed-tests total-tests) "0 tests passed.\n"] [else (format "~a of the ~a tests failed.\n\n" failed-tests total-tests)]))))] [check-outcomes - (lambda (zero-message) + (lambda (zero-message ck) (send editor insert (cond [(zero? total-checks) zero-message] - [(= 1 total-checks) "Ran 1 check.\n"] - [else (format "Ran ~a checks.\n" total-checks)])) + [(= 1 total-checks) (format "Ran 1 ~a.\n" ck)] + [else (format "Ran ~a ~as.\n" total-checks ck)])) (when (> total-checks 0) (send editor insert (cond [(and (zero? failed-checks) (= 1 total-checks)) - "Check passed!\n\n"] - [(zero? failed-checks) "All checks passed!\n\n"] - [(= failed-checks total-checks) "0 checks passed.\n"] - [else (format "~a of the ~a checks failed.\n\n" - failed-checks total-checks)]))))]) + (format "The ~a passed!\n\n" ck)] + [(zero? failed-checks) (format "All ~as passed!\n\n" ck)] + [(= failed-checks total-checks) (format "0 ~as passed.\n" ck)] + [else (format "~a of the ~a ~as failed.\n\n" + failed-checks ck total-checks)]))))]) (case style [(test-require) (test-outcomes "This program must be tested!\n") - (check-outcomes "This program is unchecked!\n")] + (check-outcomes "This program is unchecked!\n" "check")] [(check-require) - (check-outcomes "This program is unchecked!\n")] + (check-outcomes "This program is unchecked!\n" "check")] [(test-basic) (test-outcomes "") - (check-outcomes "")] - [else (check-outcomes "")]) + (check-outcomes "" "check")] + [(test-check) + (check-outcomes "This program must be tested.\n" "test")] + [else (check-outcomes "" "check")]) (unless (and (zero? total-checks) (zero? total-tests)) (inner (display-check-failures (send test-info failed-checks) diff --git a/collects/test-engine/test-engine.scm b/collects/test-engine/test-engine.scm index 66165d5577..bddda28f6f 100644 --- a/collects/test-engine/test-engine.scm +++ b/collects/test-engine/test-engine.scm @@ -75,6 +75,8 @@ (failed-check-src failed-check)) (printf "~a" "\n"))) + (define/public (report-success) (void)) + (define/public (next-line) (printf "~a" "\n\t")) ;; make-link: (listof (U string snip%)) src -> void @@ -130,24 +132,27 @@ (when (test-execute) (unless test-display (setup-display #f #f)) (let ([result (send test-info summarize-results)]) + (send test-display install-info test-info) (case result [(no-tests) (send this display-untested port)] - [(all-passed) (send this display-success port)] + [(all-passed) (send this display-success port display-event-space)] [(mixed-results) (send this display-results display-rep display-event-space)])))) - (define/public (display-success port) + (define/public (display-success port event) + (when event + (parameterize ([(dynamic-require 'scheme/gui 'current-eventspace) event]) + ((dynamic-require 'scheme/gui 'queue-callback) + (lambda () (send test-display report-success))))) (unless (test-silence) (fprintf port "All tests passed!~n"))) (define/public (display-untested port) (unless (test-silence) (fprintf port "This program should be tested.~n"))) (define/public (display-results rep event-space) - (send test-display install-info test-info) (cond [(and rep event-space) - (parameterize ([(dynamic-require 'scheme/gui 'current-eventspace) - event-space]) + (parameterize ([(dynamic-require 'scheme/gui 'current-eventspace) event-space]) ((dynamic-require 'scheme/gui 'queue-callback) (lambda () (send rep display-test-results test-display))))] [event-space diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss index 1bc8dfe3f8..00588747f3 100644 --- a/collects/tests/mzscheme/contract-test.ss +++ b/collects/tests/mzscheme/contract-test.ss @@ -3942,6 +3942,13 @@ f))]) ((((contract ctc f 'pos 'neg) 1) 2) 3)))) + (test/spec-passed + 'recursive-contract5 + '(contract (recursive-contract #f) + #f + 'pos + 'neg)) + ; @@ -4754,6 +4761,9 @@ so that propagation occurs. (define-struct s (a b)) (struct/c s any/c any/c))) + (ctest #t contract? 1) + (ctest #t contract? (-> 1 1)) + (test-flat-contract '(and/c number? integer?) 1 3/2) (test-flat-contract '(not/c integer?) #t 1) diff --git a/collects/tests/typed-scheme/succeed/little-schemer.ss b/collects/tests/typed-scheme/succeed/little-schemer.ss index 24f453e79a..95b19e8b37 100644 --- a/collects/tests/typed-scheme/succeed/little-schemer.ss +++ b/collects/tests/typed-scheme/succeed/little-schemer.ss @@ -406,7 +406,7 @@ [else (build 'primitive e)])) (define: (initial-table [name : atom]) : atom - (error)) + (error 'fail)) (define: (*identifier [e : atom] [tbl : table]) : SExp (lookup-in-table e tbl initial-table)) @@ -420,10 +420,10 @@ [(#t #f cons car cdr null? eq? atom? zero? add1 sub1 number?) *const] [else *identifier])])) -(define: (*quote [a : atom] [t : table]) : SExp (error)) -(define: (*lambda [a : atom] [t : table]) : SExp (error)) -(define: (*cond [a : atom] [t : table]) : SExp (error)) -(define: (*application [a : atom] [t : table]) : SExp (error)) +(define: (*quote [a : atom] [t : table]) : SExp (error 'fail)) +(define: (*lambda [a : atom] [t : table]) : SExp (error 'fail)) +(define: (*cond [a : atom] [t : table]) : SExp (error 'fail)) +(define: (*application [a : atom] [t : table]) : SExp (error 'fail)) (define: (list->action [e : (list-of SExp)]) : action (cond* diff --git a/collects/tests/units/test-unit.ss b/collects/tests/units/test-unit.ss index b02dd94937..061e142937 100644 --- a/collects/tests/units/test-unit.ss +++ b/collects/tests/units/test-unit.ss @@ -1640,3 +1640,40 @@ (define x 19)) (test '(3 4 19 18) (invoke-unit (compound-unit/infer (import) (export) (link u2 u1))))) + + +(define-signature sig^ (u-a)) + +(define unit@ + (unit + (import) + (export sig^) + + (define u-a 'zero))) + +(define-syntax (use-unit stx) + (syntax-case stx () + [(_) + #'(let () + (define-values/invoke-unit unit@ (import) (export sig^)) + u-a)])) + +(define-syntax (use-unit-badly1 stx) + (syntax-case stx () + [(_ u-a) + #'(let () + (define-values/invoke-unit unit@ (import) (export sig^)) + u-a)])) + +(define-syntax (use-unit-badly2 stx) + (syntax-case stx () + [(_ sig^) + #'(let () + (define-values/invoke-unit unit@ (import) (export sig^)) + u-a)])) + +(test 'zero (use-unit)) +(test-runtime-error exn:fail:contract:variable? "context mismatch; no u-a" + (use-unit-badly1 u-a)) +(test-runtime-error exn:fail:contract:variable? "context mismatch; no u-a" + (use-unit-badly2 sig^)) diff --git a/collects/typed-scheme/private/parse-type.ss b/collects/typed-scheme/private/parse-type.ss index 07adfd9e17..c04f26dc1e 100644 --- a/collects/typed-scheme/private/parse-type.ss +++ b/collects/typed-scheme/private/parse-type.ss @@ -211,8 +211,11 @@ (add-type-name-reference #'id) ;(printf "found a type name ~a~n" #'id) (make-Name #'id)] + [(eq? '-> (syntax-e #'id)) + (tc-error/delayed "Incorrect use of -> type constructor") + Univ] [else - (tc-error/delayed "unbound type name ~a" (syntax-e #'id)) + (tc-error/delayed "Unbound type name ~a" (syntax-e #'id)) Univ])] [(All . rest) (eq? (syntax-e #'All) 'All) (tc-error "All: bad syntax")] diff --git a/collects/typed-scheme/private/prims.ss b/collects/typed-scheme/private/prims.ss index dd72df9fe2..d6eb0a8365 100644 --- a/collects/typed-scheme/private/prims.ss +++ b/collects/typed-scheme/private/prims.ss @@ -160,24 +160,28 @@ This file defines two sorts of primitives. All of them are provided into any mod (syntax-property #'arg 'type-ascription #'ty)])) (define-syntax (: stx) - (let ([stx* - ;; make it possible to add another colon after the id for clarity - (syntax-case stx (:) - [(: id : . more) (syntax/loc stx (: id . more))] - [_ stx])]) - (syntax-case stx* () - [(_ id ty) - (identifier? #'id) - (syntax-property - (internal (syntax/loc stx (:-internal id ty))) - 'disappeared-use #'id)] - [(_ id ty) - (raise-syntax-error '|type declaration| "can only annotate identifiers with types" - stx #'id)] - [(_ _ _ _ . _) - (raise-syntax-error '|type declaration| "too many arguments" stx)] - [(_ _) - (raise-syntax-error '|type declaration| "too few arguments" stx)]))) + (define stx* + ;; make it possible to add another colon after the id for clarity + ;; and in that case, a `->' on the RHS does not need to be + ;; explicitly parenthesized + (syntax-case stx (:) + [(: id : x ...) + (ormap (lambda (x) (eq? '-> (syntax-e x))) (syntax->list #'(x ...))) + (syntax/loc stx (: id (x ...)))] + [(: id : . more) (syntax/loc stx (: id . more))] + [_ stx])) + (define (err str . sub) + (apply raise-syntax-error '|type declaration| str stx sub)) + (syntax-case stx* () + [(_ id ty) + (identifier? #'id) + (syntax-property (internal (syntax/loc stx (:-internal id ty))) + 'disappeared-use #'id)] + [(_ id x ...) + (case (length (syntax->list #'(x ...))) + [(1) (err "can only annotate identifiers with types" #'id)] + [(0) (err "missing type")] + [else (err "bad syntax (multiple types after identifier)")])])) (define-syntax (inst stx) (syntax-case stx (:) diff --git a/src/mzscheme/src/cstartup.inc b/src/mzscheme/src/cstartup.inc index 75dde36202..83c12af652 100644 --- a/src/mzscheme/src/cstartup.inc +++ b/src/mzscheme/src/cstartup.inc @@ -1,5 +1,5 @@ { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,49,46,50,50,0,0,0,1,0,0,6,0,9,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,49,46,51,50,0,0,0,1,0,0,6,0,9,0, 13,0,26,0,29,0,34,0,41,0,46,0,51,0,58,0,65,0,69,0,78, 0,84,0,98,0,112,0,115,0,119,0,121,0,132,0,134,0,148,0,155,0, 177,0,179,0,193,0,253,0,23,1,32,1,41,1,51,1,68,1,107,1,146, @@ -59,10 +59,10 @@ 115,101,116,45,102,105,114,115,116,11,2,24,201,250,22,74,2,20,9,248,22, 65,203,27,248,22,65,248,22,132,4,23,197,1,28,248,22,71,23,194,2,20, 15,159,36,35,36,249,22,189,3,80,158,38,35,27,248,22,132,4,248,22,64, -23,198,2,28,249,22,160,8,62,61,62,248,22,190,3,248,22,88,23,197,2, +23,198,2,28,249,22,161,8,62,61,62,248,22,190,3,248,22,88,23,197,2, 250,22,73,2,20,248,22,73,249,22,73,21,93,2,25,248,22,64,199,250,22, 74,2,8,249,22,73,2,25,249,22,73,248,22,97,203,2,25,248,22,65,202, -251,22,73,2,17,28,249,22,160,8,248,22,190,3,248,22,64,23,201,2,64, +251,22,73,2,17,28,249,22,161,8,248,22,190,3,248,22,64,23,201,2,64, 101,108,115,101,10,248,22,64,23,198,2,250,22,74,2,20,9,248,22,65,23, 201,1,249,22,63,2,8,248,22,65,23,203,1,99,8,31,8,30,8,29,8, 28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,57,57,56,50,16,4, @@ -99,7 +99,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 2032); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,49,46,50,60,0,0,0,1,0,0,3,0,16,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,49,46,51,60,0,0,0,1,0,0,3,0,16,0, 21,0,38,0,53,0,71,0,87,0,97,0,115,0,135,0,151,0,169,0,200, 0,229,0,251,0,9,1,15,1,29,1,34,1,44,1,52,1,80,1,112,1, 157,1,202,1,226,1,9,2,11,2,68,2,158,3,199,3,33,5,137,5,241, @@ -131,177 +131,177 @@ 111,114,32,98,121,116,101,32,115,116,114,105,110,103,6,36,36,99,97,110,110, 111,116,32,97,100,100,32,97,32,115,117,102,102,105,120,32,116,111,32,97,32, 114,111,111,116,32,112,97,116,104,58,32,5,0,27,20,14,159,80,158,36,50, -250,80,158,39,51,249,22,27,11,80,158,41,50,22,176,12,10,248,22,153,5, -23,196,2,28,248,22,150,6,23,194,2,12,87,94,248,22,163,8,23,194,1, +250,80,158,39,51,249,22,27,11,80,158,41,50,22,177,12,10,248,22,154,5, +23,196,2,28,248,22,151,6,23,194,2,12,87,94,248,22,164,8,23,194,1, 248,80,159,37,53,36,195,28,248,22,71,23,195,2,9,27,248,22,64,23,196, -2,27,28,248,22,157,13,23,195,2,23,194,1,28,248,22,156,13,23,195,2, -249,22,158,13,23,196,1,250,80,158,42,48,248,22,172,13,2,20,11,10,250, -80,158,40,48,248,22,172,13,2,20,23,197,1,10,28,23,193,2,249,22,63, -248,22,160,13,249,22,158,13,23,198,1,247,22,173,13,27,248,22,65,23,200, -1,28,248,22,71,23,194,2,9,27,248,22,64,23,195,2,27,28,248,22,157, -13,23,195,2,23,194,1,28,248,22,156,13,23,195,2,249,22,158,13,23,196, -1,250,80,158,47,48,248,22,172,13,2,20,11,10,250,80,158,45,48,248,22, -172,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,160,13,249,22, -158,13,23,198,1,247,22,173,13,248,80,159,45,52,36,248,22,65,23,199,1, +2,27,28,248,22,158,13,23,195,2,23,194,1,28,248,22,157,13,23,195,2, +249,22,159,13,23,196,1,250,80,158,42,48,248,22,173,13,2,20,11,10,250, +80,158,40,48,248,22,173,13,2,20,23,197,1,10,28,23,193,2,249,22,63, +248,22,161,13,249,22,159,13,23,198,1,247,22,174,13,27,248,22,65,23,200, +1,28,248,22,71,23,194,2,9,27,248,22,64,23,195,2,27,28,248,22,158, +13,23,195,2,23,194,1,28,248,22,157,13,23,195,2,249,22,159,13,23,196, +1,250,80,158,47,48,248,22,173,13,2,20,11,10,250,80,158,45,48,248,22, +173,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,161,13,249,22, +159,13,23,198,1,247,22,174,13,248,80,159,45,52,36,248,22,65,23,199,1, 87,94,23,193,1,248,80,159,43,52,36,248,22,65,23,197,1,87,94,23,193, 1,27,248,22,65,23,198,1,28,248,22,71,23,194,2,9,27,248,22,64,23, -195,2,27,28,248,22,157,13,23,195,2,23,194,1,28,248,22,156,13,23,195, -2,249,22,158,13,23,196,1,250,80,158,45,48,248,22,172,13,2,20,11,10, -250,80,158,43,48,248,22,172,13,2,20,23,197,1,10,28,23,193,2,249,22, -63,248,22,160,13,249,22,158,13,23,198,1,247,22,173,13,248,80,159,43,52, -36,248,22,65,23,199,1,248,80,159,41,52,36,248,22,65,196,27,248,22,133, -13,23,195,2,28,23,193,2,192,87,94,23,193,1,28,248,22,155,6,23,195, -2,27,248,22,155,13,195,28,192,192,248,22,156,13,195,11,87,94,28,28,248, -22,134,13,23,195,2,10,27,248,22,133,13,23,196,2,28,23,193,2,192,87, -94,23,193,1,28,248,22,155,6,23,196,2,27,248,22,155,13,23,197,2,28, -23,193,2,192,87,94,23,193,1,248,22,156,13,23,197,2,11,12,250,22,190, +195,2,27,28,248,22,158,13,23,195,2,23,194,1,28,248,22,157,13,23,195, +2,249,22,159,13,23,196,1,250,80,158,45,48,248,22,173,13,2,20,11,10, +250,80,158,43,48,248,22,173,13,2,20,23,197,1,10,28,23,193,2,249,22, +63,248,22,161,13,249,22,159,13,23,198,1,247,22,174,13,248,80,159,43,52, +36,248,22,65,23,199,1,248,80,159,41,52,36,248,22,65,196,27,248,22,134, +13,23,195,2,28,23,193,2,192,87,94,23,193,1,28,248,22,156,6,23,195, +2,27,248,22,156,13,195,28,192,192,248,22,157,13,195,11,87,94,28,28,248, +22,135,13,23,195,2,10,27,248,22,134,13,23,196,2,28,23,193,2,192,87, +94,23,193,1,28,248,22,156,6,23,196,2,27,248,22,156,13,23,197,2,28, +23,193,2,192,87,94,23,193,1,248,22,157,13,23,197,2,11,12,250,22,191, 8,76,110,111,114,109,97,108,45,112,97,116,104,45,99,97,115,101,6,42,42, 112,97,116,104,32,40,102,111,114,32,97,110,121,32,115,121,115,116,101,109,41, 32,111,114,32,118,97,108,105,100,45,112,97,116,104,32,115,116,114,105,110,103, -23,197,2,28,28,248,22,134,13,23,195,2,249,22,160,8,248,22,135,13,23, -197,2,2,21,249,22,160,8,247,22,174,7,2,21,27,28,248,22,155,6,23, -196,2,23,195,2,248,22,164,7,248,22,138,13,23,197,2,28,249,22,185,13, +23,197,2,28,28,248,22,135,13,23,195,2,249,22,161,8,248,22,136,13,23, +197,2,2,21,249,22,161,8,247,22,175,7,2,21,27,28,248,22,156,6,23, +196,2,23,195,2,248,22,165,7,248,22,139,13,23,197,2,28,249,22,186,13, 0,21,35,114,120,34,94,91,92,92,93,91,92,92,93,91,63,93,91,92,92, -93,34,23,195,2,28,248,22,155,6,195,248,22,141,13,195,194,27,248,22,130, -7,23,195,1,249,22,142,13,248,22,167,7,250,22,191,13,0,6,35,114,120, -34,47,34,28,249,22,185,13,0,22,35,114,120,34,91,47,92,92,93,91,46, -32,93,43,91,47,92,92,93,42,36,34,23,201,2,23,199,1,250,22,191,13, +93,34,23,195,2,28,248,22,156,6,195,248,22,142,13,195,194,27,248,22,131, +7,23,195,1,249,22,143,13,248,22,168,7,250,22,128,14,0,6,35,114,120, +34,47,34,28,249,22,186,13,0,22,35,114,120,34,91,47,92,92,93,91,46, +32,93,43,91,47,92,92,93,42,36,34,23,201,2,23,199,1,250,22,128,14, 0,19,35,114,120,34,91,32,46,93,43,40,91,47,92,92,93,42,41,36,34, -23,202,1,6,2,2,92,49,80,158,43,36,2,21,28,248,22,155,6,194,248, -22,141,13,194,193,87,94,28,27,248,22,133,13,23,196,2,28,23,193,2,192, -87,94,23,193,1,28,248,22,155,6,23,196,2,27,248,22,155,13,23,197,2, -28,23,193,2,192,87,94,23,193,1,248,22,156,13,23,197,2,11,12,250,22, -190,8,23,196,2,2,22,23,197,2,28,248,22,155,13,23,195,2,12,248,22, -152,11,249,22,161,10,248,22,184,6,250,22,139,7,2,23,23,200,1,23,201, -1,247,22,23,87,94,28,27,248,22,133,13,23,196,2,28,23,193,2,192,87, -94,23,193,1,28,248,22,155,6,23,196,2,27,248,22,155,13,23,197,2,28, -23,193,2,192,87,94,23,193,1,248,22,156,13,23,197,2,11,12,250,22,190, -8,23,196,2,2,22,23,197,2,28,248,22,155,13,23,195,2,12,248,22,152, -11,249,22,161,10,248,22,184,6,250,22,139,7,2,23,23,200,1,23,201,1, -247,22,23,87,94,87,94,28,27,248,22,133,13,23,196,2,28,23,193,2,192, -87,94,23,193,1,28,248,22,155,6,23,196,2,27,248,22,155,13,23,197,2, -28,23,193,2,192,87,94,23,193,1,248,22,156,13,23,197,2,11,12,250,22, -190,8,195,2,22,23,197,2,28,248,22,155,13,23,195,2,12,248,22,152,11, -249,22,161,10,248,22,184,6,250,22,139,7,2,23,199,23,201,1,247,22,23, -249,22,3,89,162,8,44,36,49,9,223,2,33,34,196,248,22,152,11,249,22, -191,10,23,196,1,247,22,23,87,94,250,80,159,38,39,36,2,7,196,197,251, +23,202,1,6,2,2,92,49,80,158,43,36,2,21,28,248,22,156,6,194,248, +22,142,13,194,193,87,94,28,27,248,22,134,13,23,196,2,28,23,193,2,192, +87,94,23,193,1,28,248,22,156,6,23,196,2,27,248,22,156,13,23,197,2, +28,23,193,2,192,87,94,23,193,1,248,22,157,13,23,197,2,11,12,250,22, +191,8,23,196,2,2,22,23,197,2,28,248,22,156,13,23,195,2,12,248,22, +153,11,249,22,162,10,248,22,185,6,250,22,140,7,2,23,23,200,1,23,201, +1,247,22,23,87,94,28,27,248,22,134,13,23,196,2,28,23,193,2,192,87, +94,23,193,1,28,248,22,156,6,23,196,2,27,248,22,156,13,23,197,2,28, +23,193,2,192,87,94,23,193,1,248,22,157,13,23,197,2,11,12,250,22,191, +8,23,196,2,2,22,23,197,2,28,248,22,156,13,23,195,2,12,248,22,153, +11,249,22,162,10,248,22,185,6,250,22,140,7,2,23,23,200,1,23,201,1, +247,22,23,87,94,87,94,28,27,248,22,134,13,23,196,2,28,23,193,2,192, +87,94,23,193,1,28,248,22,156,6,23,196,2,27,248,22,156,13,23,197,2, +28,23,193,2,192,87,94,23,193,1,248,22,157,13,23,197,2,11,12,250,22, +191,8,195,2,22,23,197,2,28,248,22,156,13,23,195,2,12,248,22,153,11, +249,22,162,10,248,22,185,6,250,22,140,7,2,23,199,23,201,1,247,22,23, +249,22,3,89,162,8,44,36,49,9,223,2,33,34,196,248,22,153,11,249,22, +128,11,23,196,1,247,22,23,87,94,250,80,159,38,39,36,2,7,196,197,251, 80,159,39,41,36,2,7,32,0,89,162,8,44,36,44,9,222,33,36,197,198, 32,38,89,162,43,41,58,65,99,108,111,111,112,222,33,39,28,248,22,71,23, -199,2,87,94,23,198,1,248,23,196,1,251,22,139,7,2,24,23,199,1,28, -248,22,71,23,203,2,87,94,23,202,1,23,201,1,250,22,1,22,151,13,23, -204,1,23,205,1,23,198,1,27,249,22,151,13,248,22,64,23,202,2,23,199, -2,28,248,22,146,13,23,194,2,27,250,22,1,22,151,13,23,197,1,23,202, -2,28,248,22,146,13,23,194,2,192,87,94,23,193,1,27,248,22,65,23,202, -1,28,248,22,71,23,194,2,87,94,23,193,1,248,23,199,1,251,22,139,7, +199,2,87,94,23,198,1,248,23,196,1,251,22,140,7,2,24,23,199,1,28, +248,22,71,23,203,2,87,94,23,202,1,23,201,1,250,22,1,22,152,13,23, +204,1,23,205,1,23,198,1,27,249,22,152,13,248,22,64,23,202,2,23,199, +2,28,248,22,147,13,23,194,2,27,250,22,1,22,152,13,23,197,1,23,202, +2,28,248,22,147,13,23,194,2,192,87,94,23,193,1,27,248,22,65,23,202, +1,28,248,22,71,23,194,2,87,94,23,193,1,248,23,199,1,251,22,140,7, 2,24,23,202,1,28,248,22,71,23,206,2,87,94,23,205,1,23,204,1,250, -22,1,22,151,13,23,207,1,23,208,1,23,201,1,27,249,22,151,13,248,22, -64,23,197,2,23,202,2,28,248,22,146,13,23,194,2,27,250,22,1,22,151, -13,23,197,1,204,28,248,22,146,13,193,192,253,2,38,203,204,205,206,23,15, +22,1,22,152,13,23,207,1,23,208,1,23,201,1,27,249,22,152,13,248,22, +64,23,197,2,23,202,2,28,248,22,147,13,23,194,2,27,250,22,1,22,152, +13,23,197,1,204,28,248,22,147,13,193,192,253,2,38,203,204,205,206,23,15, 248,22,65,201,253,2,38,202,203,204,205,206,248,22,65,200,87,94,23,193,1, 27,248,22,65,23,201,1,28,248,22,71,23,194,2,87,94,23,193,1,248,23, -198,1,251,22,139,7,2,24,23,201,1,28,248,22,71,23,205,2,87,94,23, -204,1,23,203,1,250,22,1,22,151,13,23,206,1,23,207,1,23,200,1,27, -249,22,151,13,248,22,64,23,197,2,23,201,2,28,248,22,146,13,23,194,2, -27,250,22,1,22,151,13,23,197,1,203,28,248,22,146,13,193,192,253,2,38, +198,1,251,22,140,7,2,24,23,201,1,28,248,22,71,23,205,2,87,94,23, +204,1,23,203,1,250,22,1,22,152,13,23,206,1,23,207,1,23,200,1,27, +249,22,152,13,248,22,64,23,197,2,23,201,2,28,248,22,147,13,23,194,2, +27,250,22,1,22,152,13,23,197,1,203,28,248,22,147,13,193,192,253,2,38, 202,203,204,205,206,248,22,65,201,253,2,38,201,202,203,204,205,248,22,65,200, -27,247,22,174,13,253,2,38,198,199,200,201,202,198,87,95,28,28,248,22,134, -13,23,194,2,10,27,248,22,133,13,23,195,2,28,23,193,2,192,87,94,23, -193,1,28,248,22,155,6,23,195,2,27,248,22,155,13,23,196,2,28,23,193, -2,192,87,94,23,193,1,248,22,156,13,23,196,2,11,12,252,22,190,8,23, -200,2,2,25,35,23,198,2,23,199,2,28,28,248,22,155,6,23,195,2,10, -248,22,143,7,23,195,2,87,94,23,194,1,12,252,22,190,8,23,200,2,2, -26,36,23,198,2,23,199,1,91,159,38,11,90,161,38,35,11,248,22,154,13, -23,197,2,87,94,23,195,1,87,94,28,192,12,250,22,191,8,23,201,1,2, +27,247,22,175,13,253,2,38,198,199,200,201,202,198,87,95,28,28,248,22,135, +13,23,194,2,10,27,248,22,134,13,23,195,2,28,23,193,2,192,87,94,23, +193,1,28,248,22,156,6,23,195,2,27,248,22,156,13,23,196,2,28,23,193, +2,192,87,94,23,193,1,248,22,157,13,23,196,2,11,12,252,22,191,8,23, +200,2,2,25,35,23,198,2,23,199,2,28,28,248,22,156,6,23,195,2,10, +248,22,144,7,23,195,2,87,94,23,194,1,12,252,22,191,8,23,200,2,2, +26,36,23,198,2,23,199,1,91,159,38,11,90,161,38,35,11,248,22,155,13, +23,197,2,87,94,23,195,1,87,94,28,192,12,250,22,128,9,23,201,1,2, 27,23,199,1,249,22,7,194,195,91,159,37,11,90,161,37,35,11,87,95,28, -28,248,22,134,13,23,196,2,10,27,248,22,133,13,23,197,2,28,23,193,2, -192,87,94,23,193,1,28,248,22,155,6,23,197,2,27,248,22,155,13,23,198, -2,28,23,193,2,192,87,94,23,193,1,248,22,156,13,23,198,2,11,12,252, -22,190,8,2,10,2,25,35,23,200,2,23,201,2,28,28,248,22,155,6,23, -197,2,10,248,22,143,7,23,197,2,12,252,22,190,8,2,10,2,26,36,23, -200,2,23,201,2,91,159,38,11,90,161,38,35,11,248,22,154,13,23,199,2, -87,94,23,195,1,87,94,28,23,193,2,12,250,22,191,8,2,10,2,27,23, -201,2,249,22,7,23,195,1,23,196,1,27,249,22,143,13,250,22,190,13,0, +28,248,22,135,13,23,196,2,10,27,248,22,134,13,23,197,2,28,23,193,2, +192,87,94,23,193,1,28,248,22,156,6,23,197,2,27,248,22,156,13,23,198, +2,28,23,193,2,192,87,94,23,193,1,248,22,157,13,23,198,2,11,12,252, +22,191,8,2,10,2,25,35,23,200,2,23,201,2,28,28,248,22,156,6,23, +197,2,10,248,22,144,7,23,197,2,12,252,22,191,8,2,10,2,26,36,23, +200,2,23,201,2,91,159,38,11,90,161,38,35,11,248,22,155,13,23,199,2, +87,94,23,195,1,87,94,28,23,193,2,12,250,22,128,9,2,10,2,27,23, +201,2,249,22,7,23,195,1,23,196,1,27,249,22,144,13,250,22,191,13,0, 18,35,114,120,35,34,40,91,46,93,91,94,46,93,42,124,41,36,34,248,22, -139,13,23,201,1,28,248,22,155,6,23,203,2,249,22,167,7,23,204,1,8, -63,23,202,1,28,248,22,134,13,23,199,2,248,22,135,13,23,199,1,87,94, -23,198,1,247,22,136,13,28,248,22,133,13,194,249,22,151,13,195,194,192,91, -159,37,11,90,161,37,35,11,87,95,28,28,248,22,134,13,23,196,2,10,27, -248,22,133,13,23,197,2,28,23,193,2,192,87,94,23,193,1,28,248,22,155, -6,23,197,2,27,248,22,155,13,23,198,2,28,23,193,2,192,87,94,23,193, -1,248,22,156,13,23,198,2,11,12,252,22,190,8,2,11,2,25,35,23,200, -2,23,201,2,28,28,248,22,155,6,23,197,2,10,248,22,143,7,23,197,2, -12,252,22,190,8,2,11,2,26,36,23,200,2,23,201,2,91,159,38,11,90, -161,38,35,11,248,22,154,13,23,199,2,87,94,23,195,1,87,94,28,23,193, -2,12,250,22,191,8,2,11,2,27,23,201,2,249,22,7,23,195,1,23,196, -1,27,249,22,143,13,249,22,153,7,250,22,191,13,0,9,35,114,120,35,34, -91,46,93,34,248,22,139,13,23,203,1,6,1,1,95,28,248,22,155,6,23, -202,2,249,22,167,7,23,203,1,8,63,23,201,1,28,248,22,134,13,23,199, -2,248,22,135,13,23,199,1,87,94,23,198,1,247,22,136,13,28,248,22,133, -13,194,249,22,151,13,195,194,192,249,247,22,186,4,194,11,249,80,158,37,46, -9,9,249,80,158,37,46,195,9,27,247,22,176,13,249,80,158,38,47,28,23, -195,2,27,248,22,172,7,6,11,11,80,76,84,67,79,76,76,69,67,84,83, -28,192,192,6,0,0,6,0,0,27,28,23,196,1,250,22,151,13,248,22,172, -13,69,97,100,100,111,110,45,100,105,114,247,22,170,7,6,8,8,99,111,108, +140,13,23,201,1,28,248,22,156,6,23,203,2,249,22,168,7,23,204,1,8, +63,23,202,1,28,248,22,135,13,23,199,2,248,22,136,13,23,199,1,87,94, +23,198,1,247,22,137,13,28,248,22,134,13,194,249,22,152,13,195,194,192,91, +159,37,11,90,161,37,35,11,87,95,28,28,248,22,135,13,23,196,2,10,27, +248,22,134,13,23,197,2,28,23,193,2,192,87,94,23,193,1,28,248,22,156, +6,23,197,2,27,248,22,156,13,23,198,2,28,23,193,2,192,87,94,23,193, +1,248,22,157,13,23,198,2,11,12,252,22,191,8,2,11,2,25,35,23,200, +2,23,201,2,28,28,248,22,156,6,23,197,2,10,248,22,144,7,23,197,2, +12,252,22,191,8,2,11,2,26,36,23,200,2,23,201,2,91,159,38,11,90, +161,38,35,11,248,22,155,13,23,199,2,87,94,23,195,1,87,94,28,23,193, +2,12,250,22,128,9,2,11,2,27,23,201,2,249,22,7,23,195,1,23,196, +1,27,249,22,144,13,249,22,154,7,250,22,128,14,0,9,35,114,120,35,34, +91,46,93,34,248,22,140,13,23,203,1,6,1,1,95,28,248,22,156,6,23, +202,2,249,22,168,7,23,203,1,8,63,23,201,1,28,248,22,135,13,23,199, +2,248,22,136,13,23,199,1,87,94,23,198,1,247,22,137,13,28,248,22,134, +13,194,249,22,152,13,195,194,192,249,247,22,187,4,194,11,249,80,158,37,46, +9,9,249,80,158,37,46,195,9,27,247,22,177,13,249,80,158,38,47,28,23, +195,2,27,248,22,173,7,6,11,11,80,76,84,67,79,76,76,69,67,84,83, +28,192,192,6,0,0,6,0,0,27,28,23,196,1,250,22,152,13,248,22,173, +13,69,97,100,100,111,110,45,100,105,114,247,22,171,7,6,8,8,99,111,108, 108,101,99,116,115,11,27,248,80,159,41,52,36,250,22,77,23,203,1,248,22, -73,248,22,172,13,72,99,111,108,108,101,99,116,115,45,100,105,114,23,204,1, +73,248,22,173,13,72,99,111,108,108,101,99,116,115,45,100,105,114,23,204,1, 28,23,194,2,249,22,63,23,196,1,23,195,1,192,32,48,89,162,8,44,38, -54,2,19,222,33,49,27,249,22,183,13,23,197,2,23,198,2,28,23,193,2, +54,2,19,222,33,49,27,249,22,184,13,23,197,2,23,198,2,28,23,193,2, 87,94,23,196,1,27,248,22,88,23,195,2,27,27,248,22,97,23,197,1,27, -249,22,183,13,23,201,2,23,196,2,28,23,193,2,87,94,23,194,1,27,248, +249,22,184,13,23,201,2,23,196,2,28,23,193,2,87,94,23,194,1,27,248, 22,88,23,195,2,27,250,2,48,23,203,2,23,204,1,248,22,97,23,199,1, -28,249,22,149,7,23,196,2,2,28,249,22,77,23,202,2,194,249,22,63,248, -22,142,13,23,197,1,23,195,1,87,95,23,199,1,23,193,1,28,249,22,149, -7,23,196,2,2,28,249,22,77,23,200,2,9,249,22,63,248,22,142,13,23, -197,1,9,28,249,22,149,7,23,196,2,2,28,249,22,77,197,194,87,94,23, -196,1,249,22,63,248,22,142,13,23,197,1,194,87,94,23,193,1,28,249,22, -149,7,23,198,2,2,28,249,22,77,195,9,87,94,23,194,1,249,22,63,248, -22,142,13,23,199,1,9,87,95,28,28,248,22,143,7,194,10,248,22,155,6, -194,12,250,22,190,8,2,14,6,21,21,98,121,116,101,32,115,116,114,105,110, +28,249,22,150,7,23,196,2,2,28,249,22,77,23,202,2,194,249,22,63,248, +22,143,13,23,197,1,23,195,1,87,95,23,199,1,23,193,1,28,249,22,150, +7,23,196,2,2,28,249,22,77,23,200,2,9,249,22,63,248,22,143,13,23, +197,1,9,28,249,22,150,7,23,196,2,2,28,249,22,77,197,194,87,94,23, +196,1,249,22,63,248,22,143,13,23,197,1,194,87,94,23,193,1,28,249,22, +150,7,23,198,2,2,28,249,22,77,195,9,87,94,23,194,1,249,22,63,248, +22,143,13,23,199,1,9,87,95,28,28,248,22,144,7,194,10,248,22,156,6, +194,12,250,22,191,8,2,14,6,21,21,98,121,116,101,32,115,116,114,105,110, 103,32,111,114,32,115,116,114,105,110,103,196,28,28,248,22,72,195,249,22,4, -22,133,13,196,11,12,250,22,190,8,2,14,6,13,13,108,105,115,116,32,111, -102,32,112,97,116,104,115,197,250,2,48,197,195,28,248,22,155,6,197,248,22, -166,7,197,196,32,51,89,162,8,44,39,57,2,19,222,33,54,32,52,89,162, +22,134,13,196,11,12,250,22,191,8,2,14,6,13,13,108,105,115,116,32,111, +102,32,112,97,116,104,115,197,250,2,48,197,195,28,248,22,156,6,197,248,22, +167,7,197,196,32,51,89,162,8,44,39,57,2,19,222,33,54,32,52,89,162, 8,44,38,54,70,102,111,117,110,100,45,101,120,101,99,222,33,53,28,23,193, -2,91,159,38,11,90,161,38,35,11,248,22,154,13,23,199,2,87,95,23,195, -1,23,194,1,27,28,23,198,2,27,248,22,159,13,23,201,2,28,249,22,162, -8,23,195,2,23,202,2,11,28,248,22,155,13,23,194,2,250,2,52,23,201, -2,23,202,2,249,22,151,13,23,200,2,23,198,1,250,2,52,23,201,2,23, -202,2,23,196,1,11,28,23,193,2,192,87,94,23,193,1,27,28,248,22,133, -13,23,196,2,27,249,22,151,13,23,198,2,23,201,2,28,28,248,22,146,13, -193,10,248,22,145,13,193,192,11,11,28,23,193,2,192,87,94,23,193,1,28, -23,199,2,11,27,248,22,159,13,23,202,2,28,249,22,162,8,23,195,2,23, -203,1,11,28,248,22,155,13,23,194,2,250,2,52,23,202,1,23,203,1,249, -22,151,13,23,201,1,23,198,1,250,2,52,201,202,195,194,28,248,22,71,23, -197,2,11,27,248,22,158,13,248,22,64,23,199,2,27,249,22,151,13,23,196, -1,23,197,2,28,248,22,145,13,23,194,2,250,2,52,198,199,195,87,94,23, -193,1,27,248,22,65,23,200,1,28,248,22,71,23,194,2,11,27,248,22,158, -13,248,22,64,23,196,2,27,249,22,151,13,23,196,1,23,200,2,28,248,22, -145,13,23,194,2,250,2,52,201,202,195,87,94,23,193,1,27,248,22,65,23, -197,1,28,248,22,71,23,194,2,11,27,248,22,158,13,248,22,64,195,27,249, -22,151,13,23,196,1,202,28,248,22,145,13,193,250,2,52,204,205,195,251,2, -51,204,205,206,248,22,65,199,87,95,28,27,248,22,133,13,23,196,2,28,23, -193,2,192,87,94,23,193,1,28,248,22,155,6,23,196,2,27,248,22,155,13, -23,197,2,28,23,193,2,192,87,94,23,193,1,248,22,156,13,23,197,2,11, -12,250,22,190,8,2,15,6,25,25,112,97,116,104,32,111,114,32,115,116,114, +2,91,159,38,11,90,161,38,35,11,248,22,155,13,23,199,2,87,95,23,195, +1,23,194,1,27,28,23,198,2,27,248,22,160,13,23,201,2,28,249,22,163, +8,23,195,2,23,202,2,11,28,248,22,156,13,23,194,2,250,2,52,23,201, +2,23,202,2,249,22,152,13,23,200,2,23,198,1,250,2,52,23,201,2,23, +202,2,23,196,1,11,28,23,193,2,192,87,94,23,193,1,27,28,248,22,134, +13,23,196,2,27,249,22,152,13,23,198,2,23,201,2,28,28,248,22,147,13, +193,10,248,22,146,13,193,192,11,11,28,23,193,2,192,87,94,23,193,1,28, +23,199,2,11,27,248,22,160,13,23,202,2,28,249,22,163,8,23,195,2,23, +203,1,11,28,248,22,156,13,23,194,2,250,2,52,23,202,1,23,203,1,249, +22,152,13,23,201,1,23,198,1,250,2,52,201,202,195,194,28,248,22,71,23, +197,2,11,27,248,22,159,13,248,22,64,23,199,2,27,249,22,152,13,23,196, +1,23,197,2,28,248,22,146,13,23,194,2,250,2,52,198,199,195,87,94,23, +193,1,27,248,22,65,23,200,1,28,248,22,71,23,194,2,11,27,248,22,159, +13,248,22,64,23,196,2,27,249,22,152,13,23,196,1,23,200,2,28,248,22, +146,13,23,194,2,250,2,52,201,202,195,87,94,23,193,1,27,248,22,65,23, +197,1,28,248,22,71,23,194,2,11,27,248,22,159,13,248,22,64,195,27,249, +22,152,13,23,196,1,202,28,248,22,146,13,193,250,2,52,204,205,195,251,2, +51,204,205,206,248,22,65,199,87,95,28,27,248,22,134,13,23,196,2,28,23, +193,2,192,87,94,23,193,1,28,248,22,156,6,23,196,2,27,248,22,156,13, +23,197,2,28,23,193,2,192,87,94,23,193,1,248,22,157,13,23,197,2,11, +12,250,22,191,8,2,15,6,25,25,112,97,116,104,32,111,114,32,115,116,114, 105,110,103,32,40,115,97,110,115,32,110,117,108,41,23,197,2,28,28,23,195, -2,28,27,248,22,133,13,23,197,2,28,23,193,2,192,87,94,23,193,1,28, -248,22,155,6,23,197,2,27,248,22,155,13,23,198,2,28,23,193,2,192,87, -94,23,193,1,248,22,156,13,23,198,2,11,248,22,155,13,23,196,2,11,10, -12,250,22,190,8,2,15,6,29,29,35,102,32,111,114,32,114,101,108,97,116, +2,28,27,248,22,134,13,23,197,2,28,23,193,2,192,87,94,23,193,1,28, +248,22,156,6,23,197,2,27,248,22,156,13,23,198,2,28,23,193,2,192,87, +94,23,193,1,248,22,157,13,23,198,2,11,248,22,156,13,23,196,2,11,10, +12,250,22,191,8,2,15,6,29,29,35,102,32,111,114,32,114,101,108,97,116, 105,118,101,32,112,97,116,104,32,111,114,32,115,116,114,105,110,103,23,198,2, -28,28,248,22,155,13,23,195,2,91,159,38,11,90,161,38,35,11,248,22,154, -13,23,198,2,249,22,160,8,194,68,114,101,108,97,116,105,118,101,11,27,248, -22,172,7,6,4,4,80,65,84,72,251,2,51,23,199,1,23,200,1,23,201, -1,28,23,197,2,27,249,80,158,43,47,23,200,1,9,28,249,22,160,8,247, -22,174,7,2,21,249,22,63,248,22,142,13,5,1,46,23,195,1,192,9,27, -248,22,158,13,23,196,1,28,248,22,145,13,193,250,2,52,198,199,195,11,250, -80,158,38,48,196,197,11,250,80,158,38,48,196,11,11,87,94,249,22,146,6, -247,22,182,4,195,248,22,172,5,249,22,169,3,35,249,22,153,3,197,198,27, +28,28,248,22,156,13,23,195,2,91,159,38,11,90,161,38,35,11,248,22,155, +13,23,198,2,249,22,161,8,194,68,114,101,108,97,116,105,118,101,11,27,248, +22,173,7,6,4,4,80,65,84,72,251,2,51,23,199,1,23,200,1,23,201, +1,28,23,197,2,27,249,80,158,43,47,23,200,1,9,28,249,22,161,8,247, +22,175,7,2,21,249,22,63,248,22,143,13,5,1,46,23,195,1,192,9,27, +248,22,159,13,23,196,1,28,248,22,146,13,193,250,2,52,198,199,195,11,250, +80,158,38,48,196,197,11,250,80,158,38,48,196,11,11,87,94,249,22,147,6, +247,22,183,4,195,248,22,173,5,249,22,169,3,35,249,22,153,3,197,198,27, 28,23,197,2,87,95,23,196,1,23,195,1,23,197,1,87,94,23,197,1,27, -248,22,172,13,2,20,27,249,80,158,40,48,23,196,1,11,27,27,248,22,172, +248,22,173,13,2,20,27,249,80,158,40,48,23,196,1,11,27,27,248,22,172, 3,23,200,1,28,192,192,35,27,27,248,22,172,3,23,202,1,28,192,192,35, -249,22,149,5,23,197,1,83,158,39,20,97,95,89,162,8,44,35,47,9,224, -3,2,33,58,23,195,1,23,196,1,27,248,22,134,5,23,195,1,248,80,159, +249,22,150,5,23,197,1,83,158,39,20,97,95,89,162,8,44,35,47,9,224, +3,2,33,58,23,195,1,23,196,1,27,248,22,135,5,23,195,1,248,80,159, 38,53,36,193,159,35,20,103,159,35,16,1,65,98,101,103,105,110,16,0,83, 158,41,20,100,138,67,35,37,117,116,105,108,115,2,1,11,11,10,10,42,80, 158,35,35,20,103,159,37,16,17,30,2,1,2,2,193,30,2,1,2,3,193, @@ -319,7 +319,7 @@ 0,16,0,16,0,35,35,16,0,16,17,83,158,35,16,2,89,162,43,36,48, 2,19,223,0,33,29,80,159,35,53,36,83,158,35,16,2,89,162,8,44,36, 55,2,19,223,0,33,30,80,159,35,52,36,83,158,35,16,2,32,0,89,162, -43,36,44,2,2,222,33,31,80,159,35,35,36,83,158,35,16,2,249,22,157, +43,36,44,2,2,222,33,31,80,159,35,35,36,83,158,35,16,2,249,22,158, 6,7,92,7,92,80,159,35,36,36,83,158,35,16,2,89,162,43,36,53,2, 4,223,0,33,32,80,159,35,37,36,83,158,35,16,2,32,0,89,162,8,44, 37,49,2,5,222,33,33,80,159,35,38,36,83,158,35,16,2,32,0,89,162, @@ -332,8 +332,8 @@ 35,16,2,32,0,89,162,43,36,43,2,12,222,33,44,80,159,35,45,36,83, 158,35,16,2,83,158,38,20,96,96,2,13,89,162,43,35,43,9,223,0,33, 45,89,162,43,36,44,9,223,0,33,46,89,162,43,37,54,9,223,0,33,47, -80,159,35,46,36,83,158,35,16,2,27,248,22,179,13,248,22,166,7,27,28, -249,22,160,8,247,22,174,7,2,21,6,1,1,59,6,1,1,58,250,22,139, +80,159,35,46,36,83,158,35,16,2,27,248,22,180,13,248,22,167,7,27,28, +249,22,161,8,247,22,175,7,2,21,6,1,1,59,6,1,1,58,250,22,140, 7,6,14,14,40,91,94,126,97,93,42,41,126,97,40,46,42,41,23,196,2, 23,196,1,89,162,8,44,37,47,2,14,223,0,33,50,80,159,35,47,36,83, 158,35,16,2,83,158,38,20,96,96,2,15,89,162,8,44,38,53,9,223,0, @@ -344,7 +344,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 5080); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,49,46,50,8,0,0,0,1,0,0,6,0,19,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,49,46,51,8,0,0,0,1,0,0,6,0,19,0, 34,0,48,0,62,0,76,0,111,0,0,0,255,0,0,0,65,113,117,111,116, 101,29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69,35,37, 110,101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97,109,122, @@ -361,7 +361,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 292); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,49,46,50,52,0,0,0,1,0,0,3,0,14,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,49,46,51,52,0,0,0,1,0,0,3,0,14,0, 41,0,47,0,60,0,74,0,96,0,122,0,134,0,152,0,172,0,184,0,200, 0,223,0,3,1,8,1,13,1,18,1,23,1,54,1,58,1,66,1,74,1, 82,1,185,1,230,1,250,1,29,2,64,2,98,2,108,2,155,2,165,2,172, @@ -383,31 +383,31 @@ 64,108,111,111,112,1,29,115,116,97,110,100,97,114,100,45,109,111,100,117,108, 101,45,110,97,109,101,45,114,101,115,111,108,118,101,114,63,108,105,98,67,105, 103,110,111,114,101,100,249,22,14,195,80,158,37,45,249,80,159,37,48,36,195, -10,27,28,23,195,2,28,249,22,160,8,23,197,2,80,158,38,46,87,94,23, -195,1,80,158,36,47,27,248,22,169,4,23,197,2,28,248,22,133,13,23,194, -2,91,159,38,11,90,161,38,35,11,248,22,154,13,23,197,1,87,95,83,160, +10,27,28,23,195,2,28,249,22,161,8,23,197,2,80,158,38,46,87,94,23, +195,1,80,158,36,47,27,248,22,170,4,23,197,2,28,248,22,134,13,23,194, +2,91,159,38,11,90,161,38,35,11,248,22,155,13,23,197,1,87,95,83,160, 37,11,80,158,40,46,198,83,160,37,11,80,158,40,47,192,192,11,11,28,23, -193,2,192,87,94,23,193,1,27,247,22,187,4,28,192,192,247,22,173,13,20, -14,159,80,158,35,39,250,80,158,38,40,249,22,27,11,80,158,40,39,22,187, -4,28,248,22,133,13,23,198,2,23,197,1,87,94,23,197,1,247,22,173,13, -247,194,250,22,151,13,23,197,1,23,199,1,249,80,158,42,38,23,198,1,2, -18,252,22,151,13,23,199,1,23,201,1,6,6,6,110,97,116,105,118,101,247, -22,175,7,249,80,158,44,38,23,200,1,80,158,44,35,87,94,23,194,1,27, -23,194,1,27,250,22,168,13,196,11,32,0,89,162,8,44,35,40,9,222,11, -28,192,249,22,63,195,194,11,27,248,23,195,1,23,196,1,27,250,22,168,13, +193,2,192,87,94,23,193,1,27,247,22,188,4,28,192,192,247,22,174,13,20, +14,159,80,158,35,39,250,80,158,38,40,249,22,27,11,80,158,40,39,22,188, +4,28,248,22,134,13,23,198,2,23,197,1,87,94,23,197,1,247,22,174,13, +247,194,250,22,152,13,23,197,1,23,199,1,249,80,158,42,38,23,198,1,2, +18,252,22,152,13,23,199,1,23,201,1,6,6,6,110,97,116,105,118,101,247, +22,176,7,249,80,158,44,38,23,200,1,80,158,44,35,87,94,23,194,1,27, +23,194,1,27,250,22,169,13,196,11,32,0,89,162,8,44,35,40,9,222,11, +28,192,249,22,63,195,194,11,27,248,23,195,1,23,196,1,27,250,22,169,13, 196,11,32,0,89,162,8,44,35,40,9,222,11,28,192,249,22,63,195,194,11, -249,247,22,178,13,248,22,64,195,195,27,250,22,151,13,23,198,1,23,200,1, -249,80,158,43,38,23,199,1,2,18,27,250,22,168,13,196,11,32,0,89,162, -8,44,35,40,9,222,11,28,192,249,22,63,195,194,11,249,247,22,185,4,248, -22,64,195,195,249,247,22,185,4,194,195,87,94,28,248,80,158,36,37,23,195, -2,12,250,22,190,8,77,108,111,97,100,47,117,115,101,45,99,111,109,112,105, +249,247,22,179,13,248,22,64,195,195,27,250,22,152,13,23,198,1,23,200,1, +249,80,158,43,38,23,199,1,2,18,27,250,22,169,13,196,11,32,0,89,162, +8,44,35,40,9,222,11,28,192,249,22,63,195,194,11,249,247,22,186,4,248, +22,64,195,195,249,247,22,186,4,194,195,87,94,28,248,80,158,36,37,23,195, +2,12,250,22,191,8,77,108,111,97,100,47,117,115,101,45,99,111,109,112,105, 108,101,100,6,25,25,112,97,116,104,32,111,114,32,118,97,108,105,100,45,112, 97,116,104,32,115,116,114,105,110,103,23,197,2,91,159,41,11,90,161,36,35, -11,28,248,22,157,13,23,201,2,23,200,1,27,247,22,187,4,28,23,193,2, -249,22,158,13,23,203,1,23,195,1,200,90,161,38,36,11,248,22,154,13,23, -194,2,87,94,23,196,1,90,161,36,39,11,28,249,22,160,8,23,196,2,68, +11,28,248,22,158,13,23,201,2,23,200,1,27,247,22,188,4,28,23,193,2, +249,22,159,13,23,203,1,23,195,1,200,90,161,38,36,11,248,22,155,13,23, +194,2,87,94,23,196,1,90,161,36,39,11,28,249,22,161,8,23,196,2,68, 114,101,108,97,116,105,118,101,87,94,23,194,1,2,17,23,194,1,90,161,36, -40,11,247,22,175,13,27,89,162,43,36,49,62,122,111,225,7,5,3,33,27, +40,11,247,22,176,13,27,89,162,43,36,49,62,122,111,225,7,5,3,33,27, 27,89,162,43,36,51,9,225,8,6,4,33,28,27,249,22,5,89,162,8,44, 36,47,9,223,5,33,29,23,203,2,27,28,23,195,2,27,249,22,5,83,158, 39,20,97,94,89,162,8,44,36,47,9,223,5,33,30,23,198,1,23,205,2, @@ -420,11 +420,11 @@ 199,193,11,11,11,11,28,192,249,80,159,48,54,36,203,89,162,43,35,45,9, 224,15,2,33,33,249,80,159,48,54,36,203,89,162,43,35,44,9,224,15,7, 33,34,32,36,89,162,8,44,36,54,2,19,222,33,38,0,17,35,114,120,34, -94,40,46,42,63,41,47,40,46,42,41,36,34,27,249,22,183,13,2,37,23, +94,40,46,42,63,41,47,40,46,42,41,36,34,27,249,22,184,13,2,37,23, 196,2,28,23,193,2,87,94,23,194,1,249,22,63,248,22,88,23,196,2,27, -248,22,97,23,197,1,27,249,22,183,13,2,37,23,196,2,28,23,193,2,87, +248,22,97,23,197,1,27,249,22,184,13,2,37,23,196,2,28,23,193,2,87, 94,23,194,1,249,22,63,248,22,88,23,196,2,27,248,22,97,23,197,1,27, -249,22,183,13,2,37,23,196,2,28,23,193,2,87,94,23,194,1,249,22,63, +249,22,184,13,2,37,23,196,2,28,23,193,2,87,94,23,194,1,249,22,63, 248,22,88,23,196,2,248,2,36,248,22,97,23,197,1,248,22,73,194,248,22, 73,194,248,22,73,194,32,39,89,162,43,36,54,2,19,222,33,40,28,248,22, 71,248,22,65,23,195,2,249,22,7,9,248,22,64,195,91,159,37,11,90,161, @@ -435,96 +435,96 @@ 249,22,7,249,22,63,248,22,64,23,200,1,23,197,1,23,196,1,249,22,7, 249,22,63,248,22,64,23,200,1,23,197,1,23,196,1,249,22,7,249,22,63, 248,22,64,23,200,1,23,197,1,195,27,248,2,36,23,195,1,28,194,192,248, -2,39,193,87,95,28,248,22,167,4,195,12,250,22,190,8,2,20,6,20,20, +2,39,193,87,95,28,248,22,168,4,195,12,250,22,191,8,2,20,6,20,20, 114,101,115,111,108,118,101,100,45,109,111,100,117,108,101,45,112,97,116,104,197, 28,24,193,2,248,24,194,1,195,87,94,23,193,1,12,27,27,250,22,137,2, -80,158,41,42,248,22,139,14,247,22,180,11,11,28,23,193,2,192,87,94,23, -193,1,27,247,22,121,87,94,250,22,135,2,80,158,42,42,248,22,139,14,247, -22,180,11,195,192,250,22,135,2,195,198,66,97,116,116,97,99,104,251,211,197, -198,199,10,28,192,250,22,189,8,11,196,195,248,22,187,8,194,28,249,22,161, -6,194,6,1,1,46,2,17,28,249,22,161,6,194,6,2,2,46,46,62,117, -112,192,28,249,22,162,8,248,22,65,23,200,2,23,197,1,28,249,22,160,8, -248,22,64,23,200,2,23,196,1,251,22,187,8,2,20,6,26,26,99,121,99, +80,158,41,42,248,22,140,14,247,22,181,11,11,28,23,193,2,192,87,94,23, +193,1,27,247,22,121,87,94,250,22,135,2,80,158,42,42,248,22,140,14,247, +22,181,11,195,192,250,22,135,2,195,198,66,97,116,116,97,99,104,251,211,197, +198,199,10,28,192,250,22,190,8,11,196,195,248,22,188,8,194,28,249,22,162, +6,194,6,1,1,46,2,17,28,249,22,162,6,194,6,2,2,46,46,62,117, +112,192,28,249,22,163,8,248,22,65,23,200,2,23,197,1,28,249,22,161,8, +248,22,64,23,200,2,23,196,1,251,22,188,8,2,20,6,26,26,99,121,99, 108,101,32,105,110,32,108,111,97,100,105,110,103,32,97,116,32,126,101,58,32, 126,101,23,200,1,249,22,2,22,65,248,22,78,249,22,63,23,206,1,23,202, -1,12,12,247,192,20,14,159,80,158,39,44,249,22,63,247,22,180,11,23,197, +1,12,12,247,192,20,14,159,80,158,39,44,249,22,63,247,22,181,11,23,197, 1,20,14,159,80,158,39,39,250,80,158,42,40,249,22,27,11,80,158,44,39, -22,149,4,23,196,1,249,247,22,186,4,23,198,1,248,22,52,248,22,137,13, -23,198,1,87,94,28,28,248,22,133,13,23,197,2,10,248,22,173,4,23,197, -2,12,28,23,198,2,250,22,189,8,11,6,15,15,98,97,100,32,109,111,100, -117,108,101,32,112,97,116,104,23,201,2,250,22,190,8,2,20,6,19,19,109, +22,150,4,23,196,1,249,247,22,187,4,23,198,1,248,22,52,248,22,138,13, +23,198,1,87,94,28,28,248,22,134,13,23,197,2,10,248,22,174,4,23,197, +2,12,28,23,198,2,250,22,190,8,11,6,15,15,98,97,100,32,109,111,100, +117,108,101,32,112,97,116,104,23,201,2,250,22,191,8,2,20,6,19,19,109, 111,100,117,108,101,45,112,97,116,104,32,111,114,32,112,97,116,104,23,199,2, -28,28,248,22,61,23,197,2,249,22,160,8,248,22,64,23,199,2,2,4,11, -248,22,168,4,248,22,88,197,28,28,248,22,61,23,197,2,249,22,160,8,248, +28,28,248,22,61,23,197,2,249,22,161,8,248,22,64,23,199,2,2,4,11, +248,22,169,4,248,22,88,197,28,28,248,22,61,23,197,2,249,22,161,8,248, 22,64,23,199,2,66,112,108,97,110,101,116,11,87,94,28,207,12,20,14,159, -80,158,37,39,250,80,158,40,40,249,22,27,11,80,158,42,39,22,180,11,23, -197,1,90,161,36,35,10,249,22,150,4,21,94,2,21,6,18,18,112,108,97, +80,158,37,39,250,80,158,40,40,249,22,27,11,80,158,42,39,22,181,11,23, +197,1,90,161,36,35,10,249,22,151,4,21,94,2,21,6,18,18,112,108,97, 110,101,116,47,114,101,115,111,108,118,101,114,46,115,115,1,27,112,108,97,110, 101,116,45,109,111,100,117,108,101,45,110,97,109,101,45,114,101,115,111,108,118, 101,114,12,251,211,199,200,201,202,87,94,23,193,1,27,89,162,8,44,36,45, 79,115,104,111,119,45,99,111,108,108,101,99,116,105,111,110,45,101,114,114,223, 6,33,44,27,28,248,22,51,23,199,2,27,250,22,137,2,80,158,43,43,249, -22,63,23,204,2,247,22,174,13,11,28,23,193,2,192,87,94,23,193,1,91, +22,63,23,204,2,247,22,175,13,11,28,23,193,2,192,87,94,23,193,1,91, 159,37,11,90,161,37,35,11,249,80,159,44,48,36,248,22,54,23,204,2,11, 27,251,80,158,47,50,2,20,23,202,1,28,248,22,71,23,199,2,23,199,2, 248,22,64,23,199,2,28,248,22,71,23,199,2,9,248,22,65,23,199,2,249, -22,151,13,23,195,1,28,248,22,71,23,197,1,87,94,23,197,1,6,7,7, -109,97,105,110,46,115,115,249,22,178,6,23,199,1,6,3,3,46,115,115,28, -248,22,155,6,23,199,2,87,94,23,194,1,27,248,80,159,41,55,36,23,201, +22,152,13,23,195,1,28,248,22,71,23,197,1,87,94,23,197,1,6,7,7, +109,97,105,110,46,115,115,249,22,179,6,23,199,1,6,3,3,46,115,115,28, +248,22,156,6,23,199,2,87,94,23,194,1,27,248,80,159,41,55,36,23,201, 2,27,250,22,137,2,80,158,44,43,249,22,63,23,205,2,23,199,2,11,28, 23,193,2,192,87,94,23,193,1,91,159,37,11,90,161,37,35,11,249,80,159, -45,48,36,23,204,2,11,250,22,1,22,151,13,23,199,1,249,22,77,249,22, +45,48,36,23,204,2,11,250,22,1,22,152,13,23,199,1,249,22,77,249,22, 2,32,0,89,162,8,44,36,43,9,222,33,45,23,200,1,248,22,73,23,200, -1,28,248,22,133,13,23,199,2,87,94,23,194,1,28,248,22,156,13,23,199, +1,28,248,22,134,13,23,199,2,87,94,23,194,1,28,248,22,157,13,23,199, 2,23,198,2,248,22,73,6,26,26,32,40,97,32,112,97,116,104,32,109,117, -115,116,32,98,101,32,97,98,115,111,108,117,116,101,41,28,249,22,160,8,248, +115,116,32,98,101,32,97,98,115,111,108,117,116,101,41,28,249,22,161,8,248, 22,64,23,201,2,2,21,27,250,22,137,2,80,158,43,43,249,22,63,23,204, -2,247,22,174,13,11,28,23,193,2,192,87,94,23,193,1,91,159,38,11,90, +2,247,22,175,13,11,28,23,193,2,192,87,94,23,193,1,91,159,38,11,90, 161,37,35,11,249,80,159,45,48,36,248,22,88,23,205,2,11,90,161,36,37, -11,28,248,22,71,248,22,90,23,204,2,28,248,22,71,23,194,2,249,22,185, +11,28,248,22,71,248,22,90,23,204,2,28,248,22,71,23,194,2,249,22,186, 13,0,8,35,114,120,34,91,46,93,34,23,196,2,11,10,27,27,28,23,197, 2,249,22,77,28,248,22,71,248,22,90,23,208,2,21,93,6,5,5,109,122, 108,105,98,249,22,1,22,77,249,22,2,80,159,51,56,36,248,22,90,23,211, 2,23,197,2,28,248,22,71,23,196,2,248,22,73,23,197,2,23,195,2,251, 80,158,49,50,2,20,23,204,1,248,22,64,23,198,2,248,22,65,23,198,1, -249,22,151,13,23,195,1,28,23,198,1,87,94,23,196,1,23,197,1,28,248, +249,22,152,13,23,195,1,28,23,198,1,87,94,23,196,1,23,197,1,28,248, 22,71,23,197,1,87,94,23,197,1,6,7,7,109,97,105,110,46,115,115,28, -249,22,185,13,0,8,35,114,120,34,91,46,93,34,23,199,2,23,197,1,249, -22,178,6,23,199,1,6,3,3,46,115,115,28,249,22,160,8,248,22,64,23, -201,2,64,102,105,108,101,249,22,158,13,248,22,162,13,248,22,88,23,202,2, -248,80,159,42,55,36,23,202,2,12,87,94,28,28,248,22,133,13,23,194,2, -10,248,22,177,7,23,194,2,87,94,23,200,1,12,28,23,200,2,250,22,189, -8,67,114,101,113,117,105,114,101,249,22,139,7,6,17,17,98,97,100,32,109, +249,22,186,13,0,8,35,114,120,34,91,46,93,34,23,199,2,23,197,1,249, +22,179,6,23,199,1,6,3,3,46,115,115,28,249,22,161,8,248,22,64,23, +201,2,64,102,105,108,101,249,22,159,13,248,22,163,13,248,22,88,23,202,2, +248,80,159,42,55,36,23,202,2,12,87,94,28,28,248,22,134,13,23,194,2, +10,248,22,178,7,23,194,2,87,94,23,200,1,12,28,23,200,2,250,22,190, +8,67,114,101,113,117,105,114,101,249,22,140,7,6,17,17,98,97,100,32,109, 111,100,117,108,101,32,112,97,116,104,126,97,28,23,198,2,248,22,64,23,199, -2,6,0,0,23,203,1,87,94,23,200,1,250,22,190,8,2,20,249,22,139, +2,6,0,0,23,203,1,87,94,23,200,1,250,22,191,8,2,20,249,22,140, 7,6,13,13,109,111,100,117,108,101,32,112,97,116,104,126,97,28,23,198,2, -248,22,64,23,199,2,6,0,0,23,201,2,27,28,248,22,177,7,23,195,2, -249,22,182,7,23,196,2,35,249,22,160,13,248,22,161,13,23,197,2,11,27, -28,248,22,177,7,23,196,2,249,22,182,7,23,197,2,36,248,80,158,42,51, -23,195,2,91,159,38,11,90,161,38,35,11,28,248,22,177,7,23,199,2,250, -22,7,2,22,249,22,182,7,23,203,2,37,2,22,248,22,154,13,23,198,2, -87,95,23,195,1,23,193,1,27,28,248,22,177,7,23,200,2,249,22,182,7, -23,201,2,38,249,80,158,47,52,23,197,2,5,0,27,28,248,22,177,7,23, -201,2,249,22,182,7,23,202,2,39,248,22,168,4,23,200,2,27,27,250,22, -137,2,80,158,51,42,248,22,139,14,247,22,180,11,11,28,23,193,2,192,87, -94,23,193,1,27,247,22,121,87,94,250,22,135,2,80,158,52,42,248,22,139, -14,247,22,180,11,195,192,87,95,28,23,209,1,27,250,22,137,2,23,197,2, +248,22,64,23,199,2,6,0,0,23,201,2,27,28,248,22,178,7,23,195,2, +249,22,183,7,23,196,2,35,249,22,161,13,248,22,162,13,23,197,2,11,27, +28,248,22,178,7,23,196,2,249,22,183,7,23,197,2,36,248,80,158,42,51, +23,195,2,91,159,38,11,90,161,38,35,11,28,248,22,178,7,23,199,2,250, +22,7,2,22,249,22,183,7,23,203,2,37,2,22,248,22,155,13,23,198,2, +87,95,23,195,1,23,193,1,27,28,248,22,178,7,23,200,2,249,22,183,7, +23,201,2,38,249,80,158,47,52,23,197,2,5,0,27,28,248,22,178,7,23, +201,2,249,22,183,7,23,202,2,39,248,22,169,4,23,200,2,27,27,250,22, +137,2,80,158,51,42,248,22,140,14,247,22,181,11,11,28,23,193,2,192,87, +94,23,193,1,27,247,22,121,87,94,250,22,135,2,80,158,52,42,248,22,140, +14,247,22,181,11,195,192,87,95,28,23,209,1,27,250,22,137,2,23,197,2, 197,11,28,23,193,1,12,87,95,27,27,28,248,22,17,80,158,51,45,80,158, 50,45,247,22,19,250,22,25,248,22,23,23,197,2,80,158,53,44,23,196,1, -27,247,22,180,11,249,22,3,83,158,39,20,97,94,89,162,8,44,36,54,9, +27,247,22,181,11,249,22,3,83,158,39,20,97,94,89,162,8,44,36,54,9, 226,12,11,2,3,33,46,23,195,1,23,196,1,248,28,248,22,17,80,158,50, 45,32,0,89,162,43,36,41,9,222,33,47,80,159,49,57,36,89,162,43,35, 50,9,227,14,9,8,4,3,33,48,250,22,135,2,23,197,1,197,10,12,28, -28,248,22,177,7,23,202,1,11,27,248,22,155,6,23,208,2,28,192,192,28, -248,22,61,23,208,2,249,22,160,8,248,22,64,23,210,2,2,21,11,250,22, -135,2,80,158,50,43,28,248,22,155,6,23,210,2,249,22,63,23,211,1,248, +28,248,22,178,7,23,202,1,11,27,248,22,156,6,23,208,2,28,192,192,28, +248,22,61,23,208,2,249,22,161,8,248,22,64,23,210,2,2,21,11,250,22, +135,2,80,158,50,43,28,248,22,156,6,23,210,2,249,22,63,23,211,1,248, 80,159,53,55,36,23,213,1,87,94,23,210,1,249,22,63,23,211,1,247,22, -174,13,252,22,179,7,23,208,1,23,207,1,23,205,1,23,203,1,201,12,193, +175,13,252,22,180,7,23,208,1,23,207,1,23,205,1,23,203,1,201,12,193, 91,159,37,10,90,161,36,35,10,11,90,161,36,36,10,83,158,38,20,96,96, 2,20,89,162,8,44,36,50,9,224,2,0,33,42,89,162,43,38,48,9,223, 1,33,43,89,162,43,39,8,30,9,225,2,3,0,33,49,208,87,95,248,22, -148,4,248,80,158,37,49,247,22,180,11,248,22,186,4,80,158,36,36,248,22, -171,12,80,159,36,41,36,159,35,20,103,159,35,16,1,65,98,101,103,105,110, +149,4,248,80,158,37,49,247,22,181,11,248,22,187,4,80,158,36,36,248,22, +172,12,80,159,36,41,36,159,35,20,103,159,35,16,1,65,98,101,103,105,110, 16,0,83,158,41,20,100,138,66,35,37,98,111,111,116,2,1,11,11,10,10, 36,80,158,35,35,20,103,159,39,16,19,30,2,1,2,2,193,30,2,1,2, 3,193,30,2,5,72,112,97,116,104,45,115,116,114,105,110,103,63,10,30,2, @@ -545,7 +545,7 @@ 44,9,223,0,33,24,80,159,35,56,36,83,158,35,16,2,89,162,43,36,48, 67,103,101,116,45,100,105,114,223,0,33,25,80,159,35,55,36,83,158,35,16, 2,89,162,43,37,48,68,119,105,116,104,45,100,105,114,223,0,33,26,80,159, -35,54,36,83,158,35,16,2,248,22,174,7,69,115,111,45,115,117,102,102,105, +35,54,36,83,158,35,16,2,248,22,175,7,69,115,111,45,115,117,102,102,105, 120,80,159,35,35,36,83,158,35,16,2,89,162,43,37,59,2,3,223,0,33, 35,80,159,35,36,36,83,158,35,16,2,32,0,89,162,8,44,36,41,2,7, 222,192,80,159,35,41,36,83,158,35,16,2,247,22,124,80,159,35,42,36,83, diff --git a/src/mzscheme/src/schminc.h b/src/mzscheme/src/schminc.h index 7bb57a99c7..c9d13d092e 100644 --- a/src/mzscheme/src/schminc.h +++ b/src/mzscheme/src/schminc.h @@ -13,7 +13,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 935 +#define EXPECTED_PRIM_COUNT 936 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index c653c961b8..ec07fdf294 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "4.1.1.2" +#define MZSCHEME_VERSION "4.1.1.3" #define MZSCHEME_VERSION_X 4 #define MZSCHEME_VERSION_Y 1 #define MZSCHEME_VERSION_Z 1 -#define MZSCHEME_VERSION_W 2 +#define MZSCHEME_VERSION_W 3 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index c483f01bc6..31ec03d690 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -55,6 +55,7 @@ static Scheme_Object *syntax_original_p(int argc, Scheme_Object **argv); static Scheme_Object *syntax_property(int argc, Scheme_Object **argv); static Scheme_Object *syntax_property_keys(int argc, Scheme_Object **argv); static Scheme_Object *syntax_track_origin(int argc, Scheme_Object **argv); +static Scheme_Object *syntax_transfer_intro(int argc, Scheme_Object **argv); static Scheme_Object *bound_eq(int argc, Scheme_Object **argv); static Scheme_Object *module_eq(int argc, Scheme_Object **argv); @@ -449,6 +450,12 @@ void scheme_init_stx(Scheme_Env *env) 3, 3), env); + scheme_add_global_constant("make-syntax-delta-introducer", + scheme_make_immed_prim(syntax_transfer_intro, + "make-syntax-delta-introducer", + 2, 2), + env); + scheme_add_global_constant("bound-identifier=?", scheme_make_immed_prim(bound_eq, "bound-identifier=?", @@ -6761,6 +6768,61 @@ static Scheme_Object *syntax_track_origin(int argc, Scheme_Object **argv) return scheme_stx_track(argv[0], argv[1], argv[2]); } +static Scheme_Object *delta_introducer(int argc, struct Scheme_Object *argv[], Scheme_Object *p) +{ + Scheme_Object *r, *delta; + + r = argv[0]; + + if (!SCHEME_STXP(r)) + scheme_wrong_type("delta-introducer", "syntax", 0, argc, argv); + + delta = SCHEME_PRIM_CLOSURE_ELS(p)[0]; + + for(; !SCHEME_NULLP(delta); delta = SCHEME_CDR(delta)) { + r = scheme_add_remove_mark(r, SCHEME_CAR(delta)); + } + + return r; +} + +static Scheme_Object *syntax_transfer_intro(int argc, Scheme_Object **argv) +{ + Scheme_Object *m1, *m2, *delta, *a[1]; + int l1, l2; + + if (!SCHEME_STXP(argv[0])) + scheme_wrong_type("make-syntax-delta-introducer", "syntax", 0, argc, argv); + if (!SCHEME_STXP(argv[1])) + scheme_wrong_type("make-syntax-delta-introducer", "syntax", 1, argc, argv); + + m1 = scheme_stx_extract_marks(argv[0]); + m2 = scheme_stx_extract_marks(argv[1]); + + l1 = scheme_list_length(m1); + l2 = scheme_list_length(m2); + + delta = scheme_null; + while (l1 > l2) { + delta = CONS(SCHEME_CAR(m1), delta); + m1 = SCHEME_CDR(m1); + l1--; + } + + if (!scheme_equal(m1, m2)) { + /* tails don't match, so keep all marks */ + while (l1) { + delta = CONS(SCHEME_CAR(m1), delta); + m1 = SCHEME_CDR(m1); + l1--; + } + } + + a[0] = delta; + + return scheme_make_prim_closure_w_arity(delta_introducer, 1, a, "delta-introducer", 1, 1); +} + static Scheme_Object *bound_eq(int argc, Scheme_Object **argv) { Scheme_Object *phase; diff --git a/src/worksp/mred/mred.manifest b/src/worksp/mred/mred.manifest index 4b8ac681bd..30ed6f6127 100644 --- a/src/worksp/mred/mred.manifest +++ b/src/worksp/mred/mred.manifest @@ -1,7 +1,7 @@