Allow `define`d expressions to have effects
This commit is contained in:
parent
86258acc6c
commit
01a544b0d9
|
@ -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 ...+) ≫
|
||||
|
|
|
@ -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:
|
||||
; <pkgs>/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??)
|
|
@ -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:
|
||||
; <pkgs>/syndicate/typed/tests/define-with-effects.rkt:10.2: set!: expression not allowed to have effects
|
||||
; at: (set! boo x)
|
||||
; in: (set! boo x)
|
Loading…
Reference in New Issue