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

Move syntax lifting helper to a new file in TR

Browse Source 
original commit: 4cabad171400395046602278414f190d49ca611d
This commit is contained in:
Asumu Takikawa 2014-07-23 22:39:10 -04:00
parent c62bf57372
commit 3015f2156b
2 changed files with 28 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/tc-setup.rkt
View File

@ -5,7 +5,7 @@
racket/pretty racket/promise racket/lazy-require
racket/syntax
(env type-name-env type-alias-env mvar-env)
(utils tc-utils disarm mutated-vars)
(utils tc-utils disarm mutated-vars lift)
"standard-inits.rkt"
(for-syntax racket/base)
(for-template racket/base))
@ -81,22 +81,3 @@
(define (tc-module/full orig-stx stx k)
(tc-setup orig-stx stx 'module-begin local-expand tc-module k))
;; like `local-expand/capture-lifts` but expands the lifted expression, which
;; allows us to type-check lifted expressions at the top-level
(define (local-expand/capture* stx ctx stop-ids)
(define-values (defs expr)
;; at each iteration, get lifted definitions and the expanded expression
(let loop ([stx stx])
(define stx* (local-expand/capture-lifts stx ctx stop-ids))
(syntax-parse stx*
#:literals (begin define-values)
[(begin (define-values (n) e) ... e*)
(define-values (sub-defss defs)
(for/lists (_1 _2) ([e (in-list (syntax->list #'(e ...)))]
[n (in-list (syntax->list #'(n ...)))])
;; lifted expressions may re-lift, so recur
(define-values (sub-defs e-expanded) (loop e))
(values sub-defs #`(define-values (#,n) #,e-expanded))))
(values (append (apply append sub-defss) defs) #'e*)])))
#`(begin #,@defs #,expr))

27
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/lift.rkt Normal file
View File

@ -0,0 +1,27 @@
#lang racket/base
;; This module provides helpers for syntax lifting
(require syntax/parse
(for-template racket/base))
(provide local-expand/capture*)
;; like `local-expand/capture-lifts` but expands the lifted expression, which
;; allows us to type-check lifted expressions at the top-level
(define (local-expand/capture* stx ctx stop-ids)
(define-values (defs expr)
;; at each iteration, get lifted definitions and the expanded expression
(let loop ([stx stx])
(define stx* (local-expand/capture-lifts stx ctx stop-ids))
(syntax-parse stx*
#:literals (begin define-values)
[(begin (define-values (n) e) ... e*)
(define-values (sub-defss defs)
(for/lists (_1 _2) ([e (in-list (syntax->list #'(e ...)))]
[n (in-list (syntax->list #'(n ...)))])
;; lifted expressions may re-lift, so recur
(define-values (sub-defs e-expanded) (loop e))
(values sub-defs #`(define-values (#,n) #,e-expanded))))
(values (append (apply append sub-defss) defs) #'e*)])))
#`(begin #,@defs #,expr))