diff --git a/racket/typed/core-types.rkt b/racket/typed/core-types.rkt index 8bb895f..756c58a 100644 --- a/racket/typed/core-types.rkt +++ b/racket/typed/core-types.rkt @@ -1165,7 +1165,10 @@ (syntax-local-bind-syntaxes (list x-) #f ctx) (syntax-local-bind-syntaxes (list x) #`(make-rename-transformer - (add-orig (assign-type #'#,x- #'#,t #:wrap? #f) #'#,x)) + (add-orig + (attach #'#,x- ': #'#,t) + #'#,x) + #;(add-orig (assign-type #'#,x- #'#,t #:wrap? #f) #'#,x)) ctx)) (define-for-syntax (add-bindings-to-ctx e- def-ctx) @@ -1252,26 +1255,32 @@ ;; (where walk/bind won't replace further uses) and subsequent provides #'(begin- (define-syntax x - (make-variable-like-transformer (add-orig (assign-type #'x- #'τ #:wrap? #f) #'x))) + (make-variable-like-transformer (add-orig (attach #'x- ': #'τ) #'x))) (define- x- e))])) ;; copied from ext-stlc (define-typed-syntax define [(_ x:id (~datum :) τ:type e:expr) ≫ - [⊢ e ≫ e- ⇐ τ.norm] - #:fail-unless (pure? #'e-) "expression must be pure" + [⊢ e ≫ e- (⇐ : τ.norm) (⇒ ν-ep (~effs τ-ep ...)) (⇒ ν-f (~effs τ-f ...)) (⇒ ν-s (~effs τ-s ...))] #:with x- (generate-temporary #'x) #:with x+ (syntax-local-identifier-as-binding #'x) -------- - [⊢ (define/intermediate x+ x- τ.norm e-) (⇒ : ★/t)]] + [⊢ (define/intermediate x+ x- τ.norm e-) + (⇒ : ★/t) + (⇒ ν-ep (τ-ep ...)) + (⇒ ν-f (τ-f ...)) + (⇒ ν-s (τ-s ...))]] [(_ x:id e) ≫ ;This won't work with mutually recursive definitions - [⊢ e ≫ e- ⇒ τ] - #:fail-unless (pure? #'e-) "expression must be pure" + [⊢ e ≫ e- (⇒ : τ) (⇒ ν-ep (~effs τ-ep ...)) (⇒ ν-f (~effs τ-f ...)) (⇒ ν-s (~effs τ-s ...))] #:with x- (generate-temporary #'x) #:with x+ (syntax-local-identifier-as-binding #'x) -------- - [⊢ (define/intermediate x+ x- τ e-) (⇒ : ★/t)]] + [⊢ (define/intermediate x+ x- τ e-) + (⇒ : ★/t) + (⇒ ν-ep (τ-ep ...)) + (⇒ ν-f (τ-f ...)) + (⇒ ν-s (τ-s ...))]] [(_ (f [x (~optional (~datum :)) ty:type] ... (~or (~datum →) (~datum ->)) ty_out:type) e ...+) ≫ diff --git a/racket/typed/tests/regression-count-new-words.rkt b/racket/typed/tests/regression-count-new-words.rkt new file mode 100644 index 0000000..d1bb797 --- /dev/null +++ b/racket/typed/tests/regression-count-new-words.rkt @@ -0,0 +1,31 @@ +#lang typed/syndicate/roles + +(require rackunit/turnstile) + +(define-type-alias WordCount (Hash String Int)) + +(define (word-count-increment [h : WordCount] + [word : String] + -> WordCount) + (hash-update/failure h + word + add1 + 0)) + +(define (count-new-words [word-count : WordCount] + [words : (List String)] + -> WordCount) + (for/fold ([result word-count]) + ([word words]) + (word-count-increment result word))) + +(check-type (count-new-words (hash) (list "hi" "bye")) + : WordCount + ⇒ (hash "bye" 1 "hi" 1)) + +;; OG error: +; /syndicate/typed/tests/regression-count-new-words.rkt:20.4: #%app: bad syntax +; in: (#%app word-count-increment result word) + +;; turns out I needed a #:cut in the rule for #%app (even tho it was the last +;; syntax-parse case??) diff --git a/racket/typed/tests/regression-define-with-effects.rkt b/racket/typed/tests/regression-define-with-effects.rkt new file mode 100644 index 0000000..92537e1 --- /dev/null +++ b/racket/typed/tests/regression-define-with-effects.rkt @@ -0,0 +1,17 @@ +#lang typed/syndicate/roles + +(require rackunit/turnstile) + +(check-type + (begin + (field [boo Int 0]) + (define x (begin (send! "hi") 5)) + ;; relying on `set` not allowing effects for this to be a good test + (set! boo x) + 3) + : Int) + +;; Used to get the error: +; /syndicate/typed/tests/define-with-effects.rkt:10.2: set!: expression not allowed to have effects +; at: (set! boo x) +; in: (set! boo x)