d7a87c79e0
Changed backtracking algorithm, runtime representations
- syntax classes, ~describe no longer implicitly commit
- ~describe no longer delimits effect of cut
Added keyword & optional args for stxclasses
Added ~do and #:do, ~post, ~commit and #:commit,
~delimit-cut and #:no-delimit-cut
Added syntax/parse/debug, syntax/parse/experimental/*
- expr/c for contracting macro sub-expressions
moved from syntax/parse to syntax/parse/experimental/contract
- syntax class reflection (~reflect, ~splicing-reflect)
- eh-alternative-sets (~eh-var)
- provide-syntax-class/contract
(only for params, not attrs so far)
Changed ~fail to not include POST progress (#:fail still does)
old (~fail _) is now (~post (~fail _))
Made msg argument of ~fail optional
Removed generic "repetition constraint violated" msg
Removed atom-in-list stxclass
Removed unnecessary datum->syntax on cdr of pair pattern
massive improvements to long-list microbenchmarks
Optimization: integrable syntax classes (id, expr, keyword)
need better measurements
Optimization: ad hoc elimination of head/tail choice point
for (EH ... . ()) patterns
Added unstable/wrapc (proc version of expr/c)
54 lines
1.4 KiB
Racket
54 lines
1.4 KiB
Racket
#lang racket/base
|
|
(require (for-template racket/base))
|
|
(provide txlift
|
|
get-txlifts
|
|
get-txlifts-as-definitions
|
|
call/txlifts
|
|
with-txlifts
|
|
with-txlifts/defs)
|
|
|
|
;; Like lifting definitions, but within a single transformer.
|
|
|
|
(define current-liftbox (make-parameter #f))
|
|
|
|
(define (call/txlifts proc)
|
|
(parameterize ((current-liftbox (box null)))
|
|
(proc)))
|
|
|
|
(define (txlift expr)
|
|
(let ([liftbox (current-liftbox)])
|
|
(check 'txlift liftbox)
|
|
(let ([var (car (generate-temporaries '(txlift)))])
|
|
(set-box! liftbox (cons (list var expr) (unbox liftbox)))
|
|
var)))
|
|
|
|
(define (get-txlifts)
|
|
(let ([liftbox (current-liftbox)])
|
|
(check 'get-txlifts liftbox)
|
|
(reverse (unbox liftbox))))
|
|
|
|
(define (get-txlifts-as-definitions)
|
|
(let ([liftbox (current-liftbox)])
|
|
(check 'get-txlifts-as-definitions liftbox)
|
|
(map (lambda (p)
|
|
#`(define #,@p))
|
|
(reverse (unbox liftbox)))))
|
|
|
|
(define (check who lb)
|
|
(unless (box? lb)
|
|
(error who "not in a txlift-catching context")))
|
|
|
|
(define (with-txlifts proc)
|
|
(call/txlifts
|
|
(lambda ()
|
|
(let ([v (proc)])
|
|
(with-syntax ([((var rhs) ...) (get-txlifts)])
|
|
#`(let* ([var rhs] ...) #,v))))))
|
|
|
|
(define (with-txlifts/defs proc)
|
|
(call/txlifts
|
|
(lambda ()
|
|
(let ([v (proc)])
|
|
(with-syntax ([(def ...) (get-txlifts-as-definitions)])
|
|
#`(begin def ... #,v))))))
|