local define
This commit is contained in:
parent
d7fc251bc8
commit
cabb4e2e7c
|
@ -26,7 +26,7 @@
|
||||||
;; patterns
|
;; patterns
|
||||||
bind discard
|
bind discard
|
||||||
;; primitives
|
;; primitives
|
||||||
+ - * / and or not > < >= <= = equal? displayln printf
|
+ - * / and or not > < >= <= = equal? displayln printf define
|
||||||
;; lists
|
;; lists
|
||||||
list first rest member? empty? for for/fold
|
list first rest member? empty? for for/fold
|
||||||
;; sets
|
;; sets
|
||||||
|
@ -649,6 +649,9 @@
|
||||||
ctx))
|
ctx))
|
||||||
|
|
||||||
;; -> (Values e-... (Listof Type) (Listof EndpointEffects) (Listof FacetEffects) (Listof SpawnEffects))
|
;; -> (Values e-... (Listof Type) (Listof EndpointEffects) (Listof FacetEffects) (Listof SpawnEffects))
|
||||||
|
;; recognizes local binding forms
|
||||||
|
;; (field/intermediate [x e] ...
|
||||||
|
;; (define/intermediate x x- τ e)
|
||||||
(define-for-syntax (walk/bind e...
|
(define-for-syntax (walk/bind e...
|
||||||
[def-ctx (syntax-local-make-definition-context)]
|
[def-ctx (syntax-local-make-definition-context)]
|
||||||
[unique (gensym 'walk/bind)])
|
[unique (gensym 'walk/bind)])
|
||||||
|
@ -666,12 +669,14 @@
|
||||||
(syntax->list (get-effect e- 'f))
|
(syntax->list (get-effect e- 'f))
|
||||||
(syntax->list (get-effect e- 's))))
|
(syntax->list (get-effect e- 's))))
|
||||||
(syntax-parse e-
|
(syntax-parse e-
|
||||||
#:literals (erased field/intermediate)
|
#:literals (erased field/intermediate define/intermediate)
|
||||||
[(erased (field/intermediate (x:id x-:id τ e-) ...))
|
[(erased (field/intermediate (x:id x-:id τ e-) ...))
|
||||||
(for ([orig-name (in-syntax #'(x ... ))]
|
(for ([orig-name (in-syntax #'(x ... ))]
|
||||||
[new-name (in-syntax #'(x- ...))]
|
[new-name (in-syntax #'(x- ...))]
|
||||||
[field-ty (in-syntax #'(τ ...))])
|
[field-ty (in-syntax #'(τ ...))])
|
||||||
(int-def-ctx-bind-type-rename orig-name new-name field-ty def-ctx))]
|
(int-def-ctx-bind-type-rename orig-name new-name field-ty def-ctx))]
|
||||||
|
[(erased (define/intermediate x:id x-:id τ e-))
|
||||||
|
(int-def-ctx-bind-type-rename #'x #'x- #'τ def-ctx)]
|
||||||
[_ (void)])
|
[_ (void)])
|
||||||
(values (cons e- rev-e-...)
|
(values (cons e- rev-e-...)
|
||||||
(cons τ rev-τ...)
|
(cons τ rev-τ...)
|
||||||
|
@ -1008,38 +1013,33 @@
|
||||||
------------------------------------------------
|
------------------------------------------------
|
||||||
[⊢ e- (⇒ : τ.norm) ])
|
[⊢ e- (⇒ : τ.norm) ])
|
||||||
|
|
||||||
|
(define-syntax (define/intermediate stx)
|
||||||
|
(syntax-parse stx
|
||||||
|
[(_ x:id x-:id τ e)
|
||||||
|
#'(define- x- e)]))
|
||||||
|
|
||||||
;; copied from ext-stlc
|
;; copied from ext-stlc
|
||||||
(define-typed-syntax define
|
(define-typed-syntax define
|
||||||
[(_ x:id (~datum :) τ:type e:expr) ≫
|
[(_ x:id (~datum :) τ:type e:expr) ≫
|
||||||
;[⊢ e ≫ e- ⇐ τ.norm]
|
[⊢ e ≫ e- ⇐ τ.norm]
|
||||||
|
#:fail-unless (pure? #'e-) "expression must be pure"
|
||||||
#:with x- (generate-temporary #'x)
|
#:with x- (generate-temporary #'x)
|
||||||
--------
|
--------
|
||||||
[≻ (begin-
|
[⊢ (define/intermediate x x- τ.norm e-) (⇒ : ★/t)]]
|
||||||
(define-typed-variable-rename x ≫ x- : τ.norm)
|
|
||||||
(define- x- (ann e : τ.norm)))]]
|
|
||||||
[(_ x:id e) ≫
|
[(_ x:id e) ≫
|
||||||
;This won't work with mutually recursive definitions
|
;This won't work with mutually recursive definitions
|
||||||
[⊢ e ≫ e- ⇒ τ]
|
[⊢ e ≫ e- ⇒ τ]
|
||||||
#:fail-unless (pure? #'e-) "expression must be pure"
|
#:fail-unless (pure? #'e-) "expression must be pure"
|
||||||
#:with y (generate-temporary #'x)
|
#:with x- (generate-temporary #'x)
|
||||||
#:with y+props (transfer-props #'e- (assign-type #'y #'τ #:wrap? #f))
|
|
||||||
--------
|
--------
|
||||||
[≻ (begin-
|
[⊢ (define/intermediate x x- τ e-) (⇒ : ★/t)]]
|
||||||
(define-syntax x (make-rename-transformer #'y+props))
|
|
||||||
(define- y e-))]]
|
|
||||||
;; TODO - not sure how to get this to work with effects
|
;; TODO - not sure how to get this to work with effects
|
||||||
;; right now `ann` forces the body to be pure
|
;; right now `ann` forces the body to be pure
|
||||||
[(_ (f [x (~optional (~datum :)) ty] ... (~or (~datum →) (~datum ->)) ty_out) e ...+) ≫
|
[(_ (f [x (~optional (~datum :)) ty] ... (~or (~datum →) (~datum ->)) ty_out) e ...+) ≫
|
||||||
|
[⊢ (lambda ([x : ty] ...) (ann (begin e ...) : ty_out)) ≫ e- (⇒ : fun-ty)]
|
||||||
#:with f- (add-orig (generate-temporary #'f) #'f)
|
#:with f- (add-orig (generate-temporary #'f) #'f)
|
||||||
--------
|
--------
|
||||||
[≻ (begin-
|
[⊢ (define/intermediate f f- fun-ty e-) (⇒ : ★/t)]])
|
||||||
(define-typed-variable-rename f ≫ f- : (→ ty ... (Compuation (Value ty_out)
|
|
||||||
(Endpoints)
|
|
||||||
(Roles)
|
|
||||||
(Spawns))))
|
|
||||||
(define- f-
|
|
||||||
(lambda ([x : ty] ...)
|
|
||||||
(ann (begin e ...) : ty_out))))]])
|
|
||||||
|
|
||||||
;; copied from ext-stlc
|
;; copied from ext-stlc
|
||||||
(define-typed-syntax if
|
(define-typed-syntax if
|
||||||
|
|
Loading…
Reference in New Issue