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

syntax/parse template: encourage inlining of template combinators

Browse Source 
With inlining, the optimizer can turn templates into mostly
first-order code.
This commit is contained in:
Ryan Culpepper 2017-08-13 06:41:55 -04:00 committed by Georges Dupéron
parent 034cde0a97
commit f8e01d52c6
1 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
parse/experimental/template.rkt
View File

@ -9,6 +9,7 @@
auto-syntax-e/utils)
stxparse-info/parse/private/residual
racket/private/stx
racket/performance-hint
racket/private/promise)
(provide template
template/loc
@ -618,6 +619,7 @@ A HeadGuide (HG) is one of:
- (vector 'unsyntax-splicing Id)
|#
(begin-encourage-inline
(define ((t-const) stx) stx)
(define ((t-var v) stx) v)
(define ((t-check v in-try?) stx) (check-stx stx v in-try?))
@ -634,6 +636,16 @@ A HeadGuide (HG) is one of:
(define ((t-orelse g1 g2) stx)
(with-handlers ([absent-pvar? (lambda (e) (if g2 (g2 (stx-caddr stx)) null))])
(g1 (stx-cadr stx))))
(define ((t-vector g) stx) (restx stx (list->vector (g (vector->list (syntax-e stx))))))
(define ((t-box g) stx) (restx stx (box (g (unbox (syntax-e stx))))))
(define ((t-struct g) stx)
(define s (syntax-e stx))
(define key (prefab-struct-key s))
(define elems (cdr (vector->list (struct->vector s))))
(restx stx (apply make-prefab-struct key (g elems))))
(define ((t-h g) stx) (list (g stx)))
)
(define ((t-metafun mf g) stx)
(define v (restx stx (cons (stx-car stx) (g (stx-cdr stx)))))
(define mark (make-syntax-introducer))
@ -644,14 +656,6 @@ A HeadGuide (HG) is one of:
(unless (syntax? r)
(raise-syntax-error #f "result of template metafunction was not syntax" stx))
(old-mark (mark r))))
(define ((t-vector g) stx) (restx stx (list->vector (g (vector->list (syntax-e stx))))))
(define ((t-struct g) stx)
(define s (syntax-e stx))
(define key (prefab-struct-key s))
(define elems (cdr (vector->list (struct->vector s))))
(restx stx (apply make-prefab-struct key (g elems))))
(define ((t-box g) stx) (restx stx (box (g (unbox (syntax-e stx))))))
(define ((t-h g) stx) (list (g stx)))
(define ((t-splice g) stx)
(let ([r (g (stx-cdr stx))])
(or (stx->list r)
@ -662,13 +666,14 @@ A HeadGuide (HG) is one of:
(define new-stx (g stx))
(datum->syntax new-stx (syntax-e new-stx) loc new-stx))
(begin-encourage-inline
(define (stx-cadr x) (stx-car (stx-cdr x)))
(define (stx-cddr x) (stx-cdr (stx-cdr x)))
(define (stx-caddr x) (stx-car (stx-cdr (stx-cdr x))))
(define (stx-drop n x) (for/fold ([x x]) ([i (in-range n)]) (stx-cdr x)))
(define (restx basis val)
(if (syntax? basis) (datum->syntax basis val basis basis) val))
)
;; revappend* : (Listof (Listof X)) (Listof X) -> (Listof X)
(define (revappend* xss ys)