Fix issue keep debugging

This commit is contained in:
Sam Caldwell 2020-09-24 11:05:55 -04:00
parent a1660114df
commit 27b83e5e0a
2 changed files with 5 additions and 4 deletions

View File

@ -1087,7 +1087,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(begin-for-syntax (begin-for-syntax
(define trace-sub? (make-parameter #t)) (define trace-sub? (make-parameter #f))
;; Type Type -> Bool ;; Type Type -> Bool
;; subtyping ;; subtyping
@ -1406,11 +1406,12 @@
(define-for-syntax (int-def-ctx-bind-type-rename x x- t ctx) (define-for-syntax (int-def-ctx-bind-type-rename x x- t ctx)
(when DEBUG-BINDINGS? (when DEBUG-BINDINGS?
(printf "adding to context ~a\n" (syntax-debug-info x))) (printf "adding to context ~a\n" (syntax-debug-info x)))
(define kind (detach t KIND-TAG))
(syntax-local-bind-syntaxes (list x-) #f ctx) (syntax-local-bind-syntaxes (list x-) #f ctx)
(syntax-local-bind-syntaxes (list x) (syntax-local-bind-syntaxes (list x)
#`(make-rename-transformer #`(make-rename-transformer
(add-orig (add-orig
(attach #'#,x- ': #'#,t) (attach #'#,x- ': (attach #'#,t '#,KIND-TAG #'#,kind))
#'#,x) #'#,x)
#;(add-orig (assign-type #'#,x- #'#,t #:wrap? #f) #'#,x)) #;(add-orig (assign-type #'#,x- #'#,t #:wrap? #f) #'#,x))
ctx)) ctx))

View File

@ -5,7 +5,7 @@
Either Either
left left
right right
#;partition/either) partition/either)
(require "core-types.rkt") (require "core-types.rkt")
(require "core-expressions.rkt") (require "core-expressions.rkt")
@ -23,7 +23,7 @@
x) x)
#;(define ( (X Y Z) (partition/either [xs : (List X)] (define ( (X Y Z) (partition/either [xs : (List X)]
[pred : (→fn X (U (Left Y) [pred : (→fn X (U (Left Y)
(Right Z)) #;(Either Y Z))] (Right Z)) #;(Either Y Z))]
-> (Tuple (List Y) (List Z)))) -> (Tuple (List Y) (List Z))))