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

hack to disable type checking for now

Browse Source 
svn: r17300
This commit is contained in:
Jon Rafkind 2009-12-15 00:02:22 +00:00
parent 87f05fed95
commit b9aa30a372
1 changed files with 30 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
collects/honu/private/honu.ss
View File

@ -1005,15 +1005,17 @@
#`(as-protected #,stx))]) #`(as-protected #,stx))])
(list* pack-v v (extract-type v)))) (list* pack-v v (extract-type v))))
;; (define-for-syntax certify (syntax-local-certifier))
(define-syntax (check-expr-type stx) (define-syntax (check-expr-type stx)
;; Pushes type checks down to be treated by later expansion: ;; Pushes type checks down to be treated by later expansion:
(syntax-case stx () (syntax-case stx ()
[(_ proc who type-name type-name-expr pred val) [(_ proc who type-name type-name-expr pred val)
;; Avoid the check if the static types are consistent ;; Avoid the check if the static types are consistent
(let ([v (local-expand (let ([v (local-expand
#'val #'val
'expression 'expression
prop-expand-stop-forms)]) prop-expand-stop-forms)])
;; FIXME: this is where we run afoul of certificates, because we're ;; FIXME: this is where we run afoul of certificates, because we're
;; pulling apart something produced by `local-expand'. ;; pulling apart something produced by `local-expand'.
(syntax-case v (honu-typed if (syntax-case v (honu-typed if
@ -1205,25 +1207,29 @@
(define gen-id val) (define gen-id val)
(define-syntax id (define-syntax id
(make-set!-transformer (make-set!-transformer
(lambda (stx) (lambda (stx)
(syntax-case stx (set!) (syntax-case stx (set!)
[(set! id rhs) [(set! id rhs)
(if const? (if const?
(raise-syntax-error #f "cannot assign to constant" #'id) (raise-syntax-error #f "cannot assign to constant" #'id)
(syntax/loc stx (syntax/loc stx
(set! gen-id (check-expr-type 'set! id type-name type-name-expr pred-id rhs))))] (set! gen-id (check-expr-type 'set! id type-name type-name-expr pred-id rhs))))]
[(id arg (... ...)) [(id arg (... ...))
(syntax/loc stx (syntax/loc stx
(honu-app (honu-typed gen-id id type-name protect-id) arg (... ...)))] (honu-app (honu-typed gen-id id type-name protect-id) arg (... ...)))]
[id [id
(syntax/loc stx (syntax/loc stx
(honu-typed gen-id id type-name protect-id))]))))))])) (honu-typed gen-id id type-name protect-id))]))))))]))
(define-for-syntax (make-typed-procedure gen-id result-spec arg-spec protect-id) (define-for-syntax (make-typed-procedure gen-id result-spec arg-spec protect-id)
(with-syntax ([((arg arg-type arg-type-name arg-pred-id) ...) arg-spec] (with-syntax ([((arg arg-type arg-type-name arg-pred-id) ...) arg-spec]
[(result-type result-type-name result-protect-id) result-spec] ;; FIXME! protect-id is quote-syntax'd and expanding it here
[gen-id gen-id]) ;; runs into trouble due to lexical marks
(with-syntax ([type-name #'(-> (result-type result-protect-id) (arg-type arg-type-name arg-pred-id) ...)]) ;; [(result-type result-type-name result-protect-id) result-spec]
[(result-type result-type-name result-protect-id) (list #'#f #'#f #'#f)]
[gen-id gen-id])
(with-syntax ([type-name #'(-> (result-type result-protect-id)
(arg-type arg-type-name arg-pred-id) ...)])
(make-set!-transformer (make-set!-transformer
(lambda (stx) (lambda (stx)
(syntax-case stx (set! honu-safe-use-hack) (syntax-case stx (set! honu-safe-use-hack)
@ -1245,6 +1251,11 @@
(length formal-args) (length formal-args)
(length actual-args)) (length actual-args))
stx)) stx))
;; FIXME!
#'(#%app gen-id actual-arg ...)
#;
#'(honu-typed (#%app gen-id actual-arg ...) id result-type result-protect-id)
#;
#'(honu-typed (#%app gen-id #'(honu-typed (#%app gen-id
(check-expr-type 'id 'arg arg-type arg-type-name arg-pred-id actual-arg) (check-expr-type 'id 'arg arg-type arg-type-name arg-pred-id actual-arg)
...) ...)