From 2915657c27d4bdae33a7d5749a7cae65bb0150e4 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Fri, 14 Jun 2019 01:16:33 +0200 Subject: [PATCH] template: parse ellipses using stack of map environments This is like the psyntax approach but frames are mutable and track extra information. --- racket/collects/racket/private/template.rkt | 388 +++++++++----------- 1 file changed, 164 insertions(+), 224 deletions(-) diff --git a/racket/collects/racket/private/template.rkt b/racket/collects/racket/private/template.rkt index 57f19d9053..3be440029a 100644 --- a/racket/collects/racket/private/template.rkt +++ b/racket/collects/racket/private/template.rkt @@ -73,50 +73,12 @@ ;; - (list 'h-t G) ;; - other expression (must be pair!) -;; A PVar is (pvar Id Id Id/#f Nat/#f) -;; -;; The first identifier (var) is from the syntax-mapping or attribute-binding. -;; The second (lvar) is a local variable name used to hold its value (or parts -;; thereof) in ellipsis iteration. The third is #f if var is trusted to have a -;; (Listof^depth Syntax) value, or an Id reference to a Checker procedure (see -;; below) if it needs to be checked. -;; -;; The depth-delta associated with a depth>0 pattern variable is the difference -;; between the pattern variable's depth and the depth at which it is used. (For -;; depth 0 pvars, it's #f.) For example, in -;; -;; (with-syntax ([x #'0] -;; [(y ...) #'(1 2)] -;; [((z ...) ...) #'((a b) (c d))]) -;; (template (((x y z) ...) ...))) -;; -;; the depth-delta for x is #f, the depth-delta for y is 1, and the depth-delta -;; for z is 0. The depth-delta (or depth "delay") is also the depth of the -;; ellipsis form where the variable begins to be iterated over. That is, the -;; template above should be interpreted roughly as -;; -;; (let ([Lx (pvar-value-of x)] -;; [Ly (pvar-value-of y)] -;; [Lz (pvar-value-of z)]) -;; (for/list ([Lz (in-list Lz)]) ;; depth 0 -;; (for/list ([Ly (in-list Ly)] ;; depth 1 -;; [Lz (in-list Lz)]) -;; (___ Lx Ly Lz ___)))) - (begin-for-syntax (define here-stx (quote-syntax here)) (define template-logger (make-logger 'template (current-logger))) - ;; (struct pvar (var lvar check dd) #:prefab) - (define-values (struct:pv pvar pvar? pvar-ref pvar-set!) - (make-struct-type 'pvar #f 4 0 #f null 'prefab #f '(0 1 2 3))) - (define (pvar-var pv) (pvar-ref pv 0)) - (define (pvar-lvar pv) (pvar-ref pv 1)) - (define (pvar-check pv) (pvar-ref pv 2)) - (define (pvar-dd pv) (pvar-ref pv 3)) - ;; An Attribute is an identifier statically bound to a syntax-mapping ;; (see sc.rkt) whose valvar is an identifier statically bound to an ;; attribute-mapping. @@ -170,14 +132,51 @@ [(eq? (car g2) 't-list*) (list* 't-list* g1 (cdr g2))] [else (list 't-list* g1 g2)])) + ;; A Depth is (Listof MapFrame) + + ;; A DotsFrame is (vector (Listof (cons Id Syntax)) (Hash Id => Id) Id Bool) + ;; Each ellipsis in a template has a corresponding DotsFrame of the form + ;; (vector env ht ellipsis-id any-vars?), where + ;; -- env is (list (cons iter-id src-list-expr) ...), where src-list-expr + ;; is a src-list-id either by itself or wrapped in a check + ;; -- ht maps a src-list-id to the corresponding iter-id + ;; -- ellipsis-id is the identifier for the ellipsis (for error reporting) + ;; -- any-vars? is a flag that indicates whether any pattern variables occur + ;; in this frame's subtemplate (for error reporting) + ;; When a pattern variable of depth D is found, it is added to the D current + ;; innermost (ie, topmost) dotsframes (see `lookup`). + (define (new-dotsframe ellipsis-stx) + (vector null (make-hasheq) ellipsis-stx #f)) + (define (dotsframe-env frame) (vector-ref frame 0)) + (define (dotsframe-ref frame src-id) + (hash-ref (vector-ref frame 1) src-id #f)) + (define (dotsframe-add! frame iter-id src-id src-expr) + (vector-set! frame 0 (cons (cons iter-id src-expr) (vector-ref frame 0))) + (hash-set! (vector-ref frame 1) src-id iter-id)) + (define (dotsframe-index-iter frame) (vector-ref frame 2)) + (define (dotsframe-index-iter! frame) + (cond [(vector-ref frame 2) => (lambda (x) x)] + [else (let ([index-var (gentemp)]) + (vector-set! frame 2 index-var) + index-var)])) + (define (dotsframe-ellipsis-id frame) (vector-ref frame 2)) + (define (dotsframe-has-mapvars? frame) (pair? (vector-ref frame 0))) + (define (dotsframe-has-any-vars? frame) (vector-ref frame 3)) + + (define (frames-seen-pvar! frames) + (when (pair? frames) + (unless (vector-ref (car frames) 3) + (vector-set! (car frames) 3 #t) + (frames-seen-pvar! (cdr frames))))) + + (define (ellipsis? x) + (and (identifier? x) (free-identifier=? x (quote-syntax ...)))) + ;; ---------------------------------------- ;; Parsing templates - ;; parse-template : Syntax Syntax Boolean -> (values (listof PVar) Guide (Listof Id)) + ;; parse-template : Syntax Syntax Boolean -> (values Guide (Listof Id)) (define (parse-template ctx t stx?) - ;; env : Hasheq[ (cons syntax-mapping Nat) => PVar ] - (define env (make-hasheq)) - ;; wrong-syntax : Syntax Format-String Any ... -> (error) (define (wrong-syntax x fmt . args) (raise-syntax-error #f (apply format fmt args) ctx x)) @@ -186,7 +185,7 @@ ;; disappeared! : Id -> Void (define (disappeared! id) (set! disappeared-uses (cons id disappeared-uses))) - ;; parse-t : Stx Nat Boolean -> (values (dsetof PVar) Guide) + ;; parse-t : Stx Nat Boolean -> Guide (define (parse-t t depth esc?) (cond [(stx-pair? t) (if (identifier? (stx-car t)) @@ -202,89 +201,73 @@ [(parse-form t (quote-syntax ...) 1) => (lambda (t) (disappeared! (car t)) - (define-values (drivers guide) (parse-t (cadr t) depth #t)) + (define guide (parse-t (cadr t) depth #t)) ;; Preserve t-escaped so that (t-escaped (t-const _)) != (t-const _) - (values drivers `(t-escaped ,guide)))] + `(t-escaped ,guide))] [(parse-form t (quote-syntax ~?) 2) => (lambda (t) (disappeared! (car t)) (define t1 (cadr t)) (define t2 (caddr t)) - (define-values (drivers1 guide1) (parse-t t1 depth esc?)) - (define-values (drivers2 guide2) (parse-t t2 depth esc?)) - (values (dset-union drivers1 drivers2) `(t-orelse ,guide1 ,guide2)))] + (define guide1 (parse-t t1 depth esc?)) + (define guide2 (parse-t t2 depth esc?)) + `(t-orelse ,guide1 ,guide2))] [(lookup-metafun (stx-car t)) => (lambda (mf) (unless stx? (wrong-syntax (stx-car t) "metafunctions are not supported")) (disappeared! (stx-car t)) - (define-values (drivers guide) (parse-t (stx-cdr t) depth esc?)) - (values drivers - `(t-metafun ,(metafunction-var mf) ,guide - (quote-syntax - ,(let ([tstx (and (syntax? t) t)]) - (datum->syntax tstx (cons (stx-car t) #f) tstx tstx))))))] + (define guide (parse-t (stx-cdr t) depth esc?)) + `(t-metafun ,(metafunction-var mf) ,guide + (quote-syntax + ,(let ([tstx (and (syntax? t) t)]) + (datum->syntax tstx (cons (stx-car t) #f) tstx tstx)))))] [else (parse-t-pair/dots t depth esc?)])) ;; parse-t-pair/dots : Stx Nat Boolean -> ... ;; t is a stx pair; check for dots (define (parse-t-pair/dots t depth esc?) (define head (stx-car t)) - (define-values (tail nesting) - (let loop ([tail (stx-cdr t)] [nesting 0]) - (if (and (not esc?) (stx-pair? tail) - (let ([x (stx-car tail)]) - (and (identifier? x) (free-identifier=? x (quote-syntax ...))))) - (begin (disappeared! (stx-car tail)) (loop (stx-cdr tail) (add1 nesting))) - (values tail nesting)))) - (if (zero? nesting) - (parse-t-pair/normal t depth esc?) - (let-values ([(hdrivers hguide) (parse-h head (+ depth nesting) esc?)] - [(tdrivers tguide) (parse-t tail depth esc?)]) - (when (dset-empty? hdrivers) - (wrong-syntax head "no pattern variables before ellipsis in template")) - (when (dset-empty? (dset-filter hdrivers (pvar/dd<=? depth))) - (let ([bad-dots ;; select the nestingth (last) ellipsis as the bad one - (stx-car (stx-drop nesting t))]) - ;; FIXME: improve error message? - (wrong-syntax bad-dots "too many ellipses in template"))) - ;; hdrivers is (listof (dsetof pvar)) - (define hdriverss ;; per level - (let loop ([i 0]) - (if (< i nesting) - (cons (dset-filter hdrivers (pvar/dd<=? (+ depth i))) - (loop (add1 i))) - null))) - (define at-stx (datum->syntax #f '... head)) - (define hg - (let loop ([hdriverss hdriverss]) - (cond [(null? (cdr hdriverss)) + (define-values (tail frames) ;; first-in-stx = innermost is first in list + (let loop ([tail (stx-cdr t)] [frames null]) + (cond [(and (not esc?) (stx-pair? tail) (ellipsis? (stx-car tail))) + (disappeared! (stx-car tail)) + (loop (stx-cdr tail) (cons (new-dotsframe (stx-car tail)) frames))] + [else (values tail (reverse frames))]))) + (define at-stx (datum->syntax #f '... head)) + (define hguide + (let loop ([frames frames] [hguide (parse-h head (append frames depth) esc?)]) + (cond [(pair? frames) + (define frame (car frames)) + (unless (dotsframe-has-mapvars? frame) + (unless (dotsframe-has-any-vars? frame) + (wrong-syntax head "no pattern variables before ellipsis in template")) + (wrong-syntax (dotsframe-ellipsis-id frame) "too many ellipses in template")) + (loop (cdr frames) (let ([cons? (ht-guide? hguide)] - [hguide (if (ht-guide? hguide) (ht-guide-t hguide) hguide)]) - `(t-dots ,cons? ,hguide ,(car hdriverss) - (quote ,head) (quote-syntax ,at-stx)))] - [else (let ([inner (loop (cdr hdriverss))]) - `(t-dots #f ,inner ,(car hdriverss) - (quote ,head) (quote-syntax ,at-stx)))]))) - (values (dset-union hdrivers tdrivers) - (if (equal? tguide '(t-list)) - (resyntax t hg) - (resyntax t `(t-append ,hg ,tguide))))))) + [hguide (if (ht-guide? hguide) (ht-guide-t hguide) hguide)] + [env (dotsframe-env frame)]) + ;; FIXME: optimize (x ...) case where x is trusted! + `(t-dots ,cons? ,hguide ,(map car env) ,(map cdr env) + (quote ,head) (quote-syntax ,at-stx))))] + [else hguide]))) + (define tguide (parse-t tail depth esc?)) + (cond [(equal? tguide `(t-list)) (resyntax t hguide)] + [else (resyntax t `(t-append ,hguide ,tguide))])) ;; parse-t-pair/normal : Stx Nat Boolean -> ... ;; t is a normal stx pair (define (parse-t-pair/normal t depth esc?) - (define-values (hdrivers hguide) (parse-h (stx-car t) depth esc?)) - (define-values (tdrivers tguide) (parse-t (stx-cdr t) depth esc?)) - (values (dset-union hdrivers tdrivers) - (resyntax t - (if (ht-guide? hguide) - (let ([hguide (ht-guide-t hguide)]) - (if (and (const-guide? hguide) (const-guide? tguide)) - (const-guide t) - (cons-guide hguide tguide))) - (if (equal? tguide '(t-list)) - hguide - `(t-append ,hguide ,tguide)))))) + (define hguide (parse-h (stx-car t) depth esc?)) + (define tguide (parse-t (stx-cdr t) depth esc?)) + (resyntax t + (if (ht-guide? hguide) + (let ([hguide (ht-guide-t hguide)]) + (if (and (const-guide? hguide) (const-guide? tguide)) + (const-guide t) + (cons-guide hguide tguide))) + (if (equal? tguide '(t-list)) + hguide + `(t-append ,hguide ,tguide))))) ;; parse-t-nonpair : Syntax Nat Boolean -> ... ;; PRE: t is not a stxpair @@ -298,92 +281,89 @@ (wrong-syntax t "illegal use")] [(lookup-metafun t) (wrong-syntax t "illegal use of syntax metafunction")] - [(lookup t depth) - => (lambda (pvar) - (disappeared! t) - (values (dset pvar) - (cond [(pvar-check pvar) - => (lambda (check) - `(#%expression - (,check ,(pvar-lvar pvar) 0 #t (quote-syntax ,t))))] - [else `(t-var ,(pvar-lvar pvar))])))] - [else (values (dset) (const-guide t))])] + [(lookup t depth) => (lambda (ref) ref)] + [else (const-guide t)])] [(vector? td) - (define-values (drivers guide) (parse-t (vector->list td) depth esc?)) - (values drivers - (cond [(const-guide? guide) (const-guide t)] - [else (resyntax t `(t-vector ,guide))]))] + (define guide (parse-t (vector->list td) depth esc?)) + (cond [(const-guide? guide) (const-guide t)] + [else (resyntax t `(t-vector ,guide))])] [(prefab-struct-key td) => (lambda (key) - (define-values (drivers guide) + (define guide (let ([elems (cdr (vector->list (struct->vector td)))]) (parse-t elems depth esc?))) - (values drivers - (cond [(const-guide? guide) (const-guide t)] - [else (resyntax t `(t-struct (quote ,key) ,guide))])))] + (cond [(const-guide? guide) (const-guide t)] + [else (resyntax t `(t-struct (quote ,key) ,guide))]))] [(box? td) - (define-values (drivers guide) (parse-t (unbox td) depth esc?)) - (values drivers (if (const-guide? guide) (const-guide t) (resyntax t `(t-box ,guide))))] - [else (values (dset) (const-guide t))])) + (define guide (parse-t (unbox td) depth esc?)) + (if (const-guide? guide) (const-guide t) (resyntax t `(t-box ,guide)))] + [else (const-guide t)])) - ;; parse-h : Syntax Nat Boolean -> (values (dsetof PVar) HeadGuide) + ;; parse-h : Syntax Depth Boolean -> HeadGuide (define (parse-h h depth esc?) (cond [(and (not esc?) (parse-form h (quote-syntax ~?) 1)) => (lambda (h) (disappeared! (car h)) - (define-values (drivers guide) (parse-h (cadr h) depth esc?)) - (values drivers `(h-orelse ,guide null)))] + (define guide (parse-h (cadr h) depth esc?)) + `(h-orelse ,guide null))] [(and (not esc?) (parse-form h (quote-syntax ~?) 2)) => (lambda (h) (disappeared! (car h)) - (define-values (drivers1 guide1) (parse-h (cadr h) depth esc?)) - (define-values (drivers2 guide2) (parse-h (caddr h) depth esc?)) - (values (dset-union drivers1 drivers2) - (if (and (ht-guide? guide1) (ht-guide? guide2)) - `(h-t (t-orelse ,(ht-guide-t guide1) ,(ht-guide-t guide2))) - `(h-orelse ,guide1 ,guide2))))] + (define guide1 (parse-h (cadr h) depth esc?)) + (define guide2 (parse-h (caddr h) depth esc?)) + (if (and (ht-guide? guide1) (ht-guide? guide2)) + `(h-t (t-orelse ,(ht-guide-t guide1) ,(ht-guide-t guide2))) + `(h-orelse ,guide1 ,guide2)))] [(and (stx-pair? h) (let ([h-head (stx-car h)]) (and (identifier? h-head) (or (and (free-identifier=? h-head (quote-syntax ~@)) (not esc?)) (free-identifier=? h-head (quote-syntax ~@!)))))) (disappeared! (stx-car h)) - (define-values (drivers guide) (parse-t (stx-cdr h) depth esc?)) - (values drivers `(h-splice ,guide (quote ,h) (quote-syntax ,(stx-car h))))] + (define guide (parse-t (stx-cdr h) depth esc?)) + `(h-splice ,guide (quote ,h) (quote-syntax ,(stx-car h)))] [else - (define-values (drivers guide) (parse-t h depth esc?)) - (values drivers `(h-t ,guide))])) + (define guide (parse-t h depth esc?)) + `(h-t ,guide)])) - ;; lookup : Identifier Nat -> PVar/#f - (define (lookup id depth) + ;; lookup : Identifier Depth -> Syntax/#f + ;; If pattern variable with depth>0, insert into depth innermost ellipsis envs. + (define (lookup id depth0) (define (make-pvar var check pvar-depth) - (cond [(zero? pvar-depth) - (pvar var var check #f)] - [(>= depth pvar-depth) - (pvar var (gentemp) check (- depth pvar-depth))] - [(zero? depth) - (wrong-syntax id "missing ellipsis with pattern variable in template")] - [else - (wrong-syntax id "too few ellipses for pattern variable in template")])) - (define (hash-ref! h k proc) - (let ([v (hash-ref h k #f)]) (if v v (let ([v* (proc)]) (hash-set! h k v*) v*)))) + (define (make-ref var) + (cond [check `(t-check-var (,check ,var 0 #t (quote-syntax ,id)))] + [else `(t-var ,var)])) + (define (make-src-ref var id) + (cond [check `(#%expression (,check ,var 1 #f (quote-syntax ,id)))] + [else `(#%expression ,var)])) + (frames-seen-pvar! depth0) + (make-ref + (let dloop ([depth depth0] [pvar-depth pvar-depth]) ;; ... -> Identifier + ;; Returns variable reference whose value has not been checked yet. + (cond [(zero? pvar-depth) var] + [(null? depth) + (if (null? depth0) + (wrong-syntax id "missing ellipsis with pattern variable in template") + (wrong-syntax id "too few ellipses for pattern variable in template"))] + [else + (define src (dloop (cdr depth) (sub1 pvar-depth))) + (or (dotsframe-ref (car depth) src) + (let ([iter (gentemp)]) + (dotsframe-add! (car depth) iter src (make-src-ref src id)) + iter))])))) (let ([v (syntax-local-value id (lambda () #f))]) - (cond [(syntax-pattern-variable? v) - (hash-ref! env (cons v depth) - (lambda () - (define pvar-depth (syntax-mapping-depth v)) - (define attr - (let ([attr (syntax-local-value (syntax-mapping-valvar v) (lambda () #f))]) - (and (attribute-mapping? attr) attr))) - (define var (if attr (attribute-mapping-var attr) (syntax-mapping-valvar v))) - (define check (and attr (attribute-mapping-check attr))) - (make-pvar var check pvar-depth)))] - [(s-exp-pattern-variable? v) - (hash-ref! env (cons v depth) - (lambda () - (define pvar-depth (s-exp-mapping-depth v)) - (define var (s-exp-mapping-valvar v)) - (make-pvar var #f pvar-depth)))] + (cond [(and stx? (syntax-pattern-variable? v)) + (define pvar-depth (syntax-mapping-depth v)) + (define attr + (let ([attr (syntax-local-value (syntax-mapping-valvar v) (lambda () #f))]) + (and (attribute-mapping? attr) attr))) + (define var (if attr (attribute-mapping-var attr) (syntax-mapping-valvar v))) + (define check (and attr (attribute-mapping-check attr))) + (make-pvar var check pvar-depth)] + [(and (not stx?) (s-exp-pattern-variable? v)) + (define pvar-depth (s-exp-mapping-depth v)) + (define var (s-exp-mapping-valvar v)) + (make-pvar var #f pvar-depth)] [else ;; id is a constant; check that for all x s.t. id = x.y, x is not an attribute (for-each @@ -459,8 +439,8 @@ [(syntax? x) `(t-const (quote-syntax ,x))] [else `(t-const (syntax-e (quote-syntax ,(datum->syntax #f x))))])) - (let-values ([(drivers guide) (parse-t t 0 #f)]) - (values (dset->list drivers) guide disappeared-uses))) + (let ([guide (parse-t t null #f)]) + (values guide disappeared-uses))) ;; parse-form : Stx Id Nat -> (list[arity+1] Syntax) (define (parse-form stx form-id arity) @@ -489,9 +469,6 @@ (map (lambda (loc) (datum->syntax id (string->symbol (substring id-string 0 loc)))) dot-locations))) - (define (pvar/dd<=? expected-dd) - (lambda (x) (let ([dd (pvar-dd x)]) (and dd (<= dd expected-dd))))) - (define gentemp-counter 0) (define (gentemp) (set! gentemp-counter (add1 gentemp-counter)) @@ -501,29 +478,6 @@ (define (stx-drop n x) (if (zero? n) x (stx-drop (sub1 n) (stx-cdr x)))) - ;; ---------------------------------------- - ;; Deterministic Sets - ;; FIXME: detect big unions, use hash table - - (define (dset . xs) xs) - (define (dset-empty? ds) (null? ds)) - (define (dset-filter ds pred) (filter pred ds)) - (define (dset->list ds) ds) - (define (dset-union ds1 ds2) - (if (pair? ds1) - (let ([elem (car ds1)]) - (if (member elem ds2) - (dset-union (cdr ds1) ds2) - (dset-union (cdr ds1) (cons (car ds1) ds2)))) - ds2)) - - (define (filter keep? xs) - (if (pair? xs) - (if (keep? (car xs)) - (cons (car xs) (filter keep? (cdr xs))) - (filter keep? (cdr xs))) - null)) - ;; ---------------------------------------- ;; Relocating (eg, syntax/loc) @@ -559,17 +513,13 @@ ;; do-template : Syntax Syntax Id/#f Boolean -> Syntax (define (do-template ctx tstx loc-id stx?) - (define-values (pvars pre-guide disappeared-uses) + (define-values (pre-guide disappeared-uses) (parse-template ctx tstx stx?)) (define guide (if loc-id (relocate-guide ctx pre-guide loc-id) pre-guide)) - (define ell-pvars (filter pvar-dd pvars)) (define pre-code (if (const-guide? guide) (if stx? `(quote-syntax ,tstx) `(quote ,tstx)) - (let ([lvars (map pvar-lvar ell-pvars)] - [valvars (map pvar-var ell-pvars)]) - `(let (,@(map list lvars valvars)) - ,(datum->syntax here-stx guide))))) + guide)) (define code (syntax-arm (datum->syntax here-stx pre-code ctx))) (syntax-property code 'disappeared-use (map syntax-local-introduce disappeared-uses))) ) @@ -609,33 +559,22 @@ ;; ============================================================ ;; Run-time support -;; (t-dots cons? hguide hdrivers) : Expr[(Listof Syntax)] +;; (t-dots cons? hguide iter-vars src-vars head-datum at-stx) : Expr[(Listof Syntax)] (define-syntax (t-dots stx) (define s (syntax->list stx)) (define cons? (syntax-e (list-ref s 1))) (define head (list-ref s 2)) - (define drivers (map syntax-e (syntax->list (list-ref s 3)))) ;; (Listof PVar) - (define in-stx (list-ref s 4)) - (define at-stx (list-ref s 5)) - (cond - ;; Case 1: (x ...) where x is trusted - [(and cons? (let ([head-s (syntax->list head)]) - (and (pair? head-s) (eq? (syntax-e (car head-s)) 't-var)))) - head] - ;; General case - [else - ;; var-value-expr : Id Id/#'#f -> Expr[List] - (define (var-value-expr lvar check) - (if (syntax-e check) `(,check ,lvar 1 #f #f) lvar)) - (define lvars (map pvar-lvar drivers)) - (define checks (map pvar-check drivers)) - (define code - `(let ,(map list lvars (map var-value-expr lvars checks)) - ,(if (> (length lvars) 1) `(check-same-length ,in-stx ,at-stx . ,lvars) '(void)) - ,(if cons? - `(map (lambda ,lvars ,head) . ,lvars) - `(apply append (map (lambda ,lvars ,head) . ,lvars))))) - (datum->syntax here-stx code stx)])) + (define iter-vars (syntax->list (list-ref s 3))) + (define src-exprs (syntax->list (list-ref s 4))) + (define in-stx (list-ref s 5)) + (define at-stx (list-ref s 6)) + (define code + `(let ,(map list iter-vars src-exprs) + ,(if (> (length iter-vars) 1) `(check-same-length ,in-stx ,at-stx . ,iter-vars) '(void)) + ,(if cons? + `(map (lambda ,iter-vars ,head) . ,iter-vars) + `(apply append (map (lambda ,iter-vars ,head) . ,iter-vars))))) + (datum->syntax here-stx code stx)) (define-syntaxes (t-orelse h-orelse) (let () @@ -647,6 +586,7 @@ (#%require (rename '#%kernel t-const #%expression) (rename '#%kernel t-var #%expression) + (rename '#%kernel t-check-var #%expression) ;; (rename '#%kernel t-append append) (rename '#%kernel t-list list) (rename '#%kernel t-list* list*)