From 993c81858092e8f8b29009c0555ddb1b5b173f1c Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sat, 3 Aug 2024 21:29:06 -0400 Subject: [PATCH 01/25] ellipses in binding specs, existing examples work --- private/runtime/binding-spec.rkt | 79 ++++++++++- private/syntax/compile/binding-spec.rkt | 168 ++++++++++++++---------- private/test/sequence.rkt | 2 +- tests/dsls/cmdline/cmdline.rkt | 2 +- 4 files changed, 179 insertions(+), 72 deletions(-) diff --git a/private/runtime/binding-spec.rkt b/private/runtime/binding-spec.rkt index c09cad7..b70e25f 100644 --- a/private/runtime/binding-spec.rkt +++ b/private/runtime/binding-spec.rkt @@ -11,13 +11,14 @@ (struct-out bind) (struct-out bind-syntax) (struct-out bind-syntaxes) - (struct-out scope) ; {} + (struct-out scope) (struct-out group) ; [] (struct-out nest) (struct-out nest-one) (struct-out nested) (struct-out suspend) (struct-out fresh-env-expr-ctx) + (struct-out ellipsis) ; ... ; used by interface macros expand-top @@ -63,11 +64,12 @@ (struct bind-syntaxes [pvar space bvalc transformer-pvar] #:transparent) (struct scope [spec] #:transparent) (struct group [specs] #:transparent) -(struct nest [pvar nonterm spec] #:transparent) +(struct nest [depth pvar nonterm spec] #:transparent) (struct nest-one [pvar nonterm spec] #:transparent) (struct nested [] #:transparent) (struct suspend [pvar] #:transparent) (struct fresh-env-expr-ctx [spec] #:transparent) +(struct ellipsis [pvars spec] #:transparent) ;; ;; Expansion @@ -79,14 +81,18 @@ ;; Helpers for accessing and updating parts of the exp-state +; exp-state? symbol? -> (treeof syntax?) (define (get-pvar st pv) (hash-ref (exp-state-pvar-vals st) pv)) +; exp-state? symbol? (treeof syntax?) -> (treeof syntax?) (define (set-pvar st pv val) (struct-copy exp-state st [pvar-vals (hash-set (exp-state-pvar-vals st) pv val)])) +; exp-state? (listof symbol?) ((treeof syntax?) ... -> (treeof syntax?)) -> exp-state? +; updates the environment by applying f to the values of pvs (define (update-pvar* st pvs f) (define env (exp-state-pvar-vals st)) (define vals (for/list ([pv pvs]) (hash-ref env pv))) @@ -101,6 +107,7 @@ exp-state st [pvar-vals env^])) +; exp-state? ((or/c #f nest-call? nest-ret?) -> (or/c #f nest-call? nest-ret?)) -> exp-state? (define (update-nest-state st f) (struct-copy exp-state st @@ -271,7 +278,10 @@ ([spec specs]) (simple-expand-internal spec st local-scopes))] - [(nest pv f inner-spec) + [(nest depth pv f inner-spec) + (unless (= 1 depth) + (error "don't know how to handle depth > 1 yet")) + (define init-seq (get-pvar st pv)) (define res @@ -299,7 +309,18 @@ [(suspend pv) (for/pv-state-tree ([stx pv]) - (make-suspension (add-scopes stx local-scopes) (current-def-ctx)))])) + (make-suspension (add-scopes stx local-scopes) (current-def-ctx)))] + [(ellipsis pvs spec) + ; filter and split the environments + (define sts (exp-state-split/ellipsis st pvs)) + ; expand on each sub-environment + (define sts^ + (for/list ([st sts]) + (simple-expand-internal spec st local-scopes))) + ; unsplit the sub-environments and merge that into the initial env. + (for/fold ([st st]) + ([pv pvs]) + (set-pvar st pv (for/list ([st^ sts^]) (hash-ref st^ pv))))])) ; f is nonterm-transformer ; seq is (listof (treeof syntax?)) @@ -325,6 +346,56 @@ (call-reconstruct-function (exp-state-pvar-vals st^) reconstruct-f) (exp-state-nest-state st^))])) +; exp-state? (listof symbol?) -> (listof exp-state?) +(define (exp-state-split/ellipsis st pvars) + (match st + [(exp-state pvar-vals nest-state) + (exp-state (env-split/ellipsis pvar-vals pvars) + nest-state)])) + +; (hash symbol? (treeof syntax?)) (listof symbol?) -> (listof (hash symbol? (treeof syntax?))) +; Spit up the environment into a list of envs. One per element of a pvar's value. +; Filters environment to just pvars. +; Pvars should be mapped to lists of equal lengths. Errors if they aren't. +(define (env-split/ellipsis env pvars) + (define env-filtered + (for/hash ([(pv vs) (in-hash env)] + #:when (member pv pvars)) + (values pv vs))) + (define repetition-length (env-repetition-length env-filtered)) + (for/list ([i (in-range repetition-length)]) + (for/hash ([(pv vs) (in-hash env-filtered)]) + (values pv (list-ref vs i))))) + +(module+ test + (check-equal? (env-split/ellipsis (hash 'a '(1 2 3) 'b '(4 5 6) 'c '()) + '(a b)) + (list (hash 'a 1 'b 4) + (hash 'a 2 'b 5) + (hash 'a 3 'b 6)))) + +; (hash symbol? (treeof syntax?)) -> natural? +; Assuming this environment is getting split for ellipses, computes how many environments it should get split into. +; Errors if not all trees have the same length. +(define (env-repetition-length env) + (define result + (or (for/first ([(_ vs) (in-hash env)]) + (unless (list? vs) + ; TODO check in compiler + (error "too many ellipses in template")) + (length vs)) + 0)) + (for ([(_ vs) (in-hash env)]) + (unless (= (length vs) result) + ; TODO Can this be checked in the compiler? Would need to make sure ellipsized bs vars + ; come from the same ss ellipsis. + (error "incompatible ellipsis match counts for template"))) + result) + +(module+ test + (check-equal? (env-repetition-length (hash 'a '(1 2 3) 'b '(4 5 6))) + 3)) + ;; When entering a `nest-one` or `nest` form, add an extra scope. This means that the ;; expansion within is in a new definition context with a scope distinguishing it from ;; surrounding definition contexts where macros may have been defined. The Racket expander diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index 471889d..46641f0 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -54,15 +54,16 @@ (struct bind with-stx [pvar] #:transparent) (struct bind-syntax with-stx [pvar transformer-pvar] #:transparent) (struct bind-syntaxes with-stx [pvar transformer-pvar] #:transparent) -(struct rec with-stx [pvars] #:transparent) -(struct re-export with-stx [pvars] #:transparent) +(struct rec with-stx [pvar] #:transparent) +(struct re-export with-stx [pvar] #:transparent) (struct export with-stx [pvar] #:transparent) (struct export-syntax with-stx [pvar transformer-pvar] #:transparent) (struct export-syntaxes with-stx [pvar transformer-pvar] #:transparent) -(struct nest with-stx [pvar spec] #:transparent) +(struct nest with-stx [depth pvar spec] #:transparent) (struct nest-one with-stx [pvar spec] #:transparent) (struct suspend with-stx [pvar] #:transparent) (struct scope with-stx [spec] #:transparent) +(struct ellipsis with-stx [spec] #:transparent) (struct group [specs] #:transparent) (define-match-expander s* @@ -74,9 +75,9 @@ ; bottom-up mapping of spec (define (map-bspec f spec) (match spec - [(nest stx pv s) + [(nest stx depth pv s) (let ([s^ (map-bspec f s)]) - (f (nest stx pv s^)))] + (f (nest stx depth pv s^)))] [(nest-one stx pv s) (let ([s^ (map-bspec f s)]) (f (nest-one stx pv s^)))] @@ -86,6 +87,8 @@ [(group ss) (let ([ss^ (map (lambda (s) (map-bspec f s)) ss)]) (f (group ss^)))] + [(ellipsis stx s) + (f (ellipsis stx (map-bspec f s)))] [_ (f spec)])) #;(∀ A ((BSpec (listof A) -> A) BSpec -> A)) @@ -94,7 +97,8 @@ (match spec [(or (s* nest [spec s]) (s* nest-one [spec s]) - (s* scope [spec s])) + (s* scope [spec s]) + (s* ellipsis [spec s])) (let ([s^ (fold-bspec f s)]) (f spec (list s^)))] [(group ss) @@ -112,14 +116,12 @@ #:datum-literals (scope bind bind-syntax bind-syntaxes import export export-syntax export-syntaxes re-export nest nest-one host) [v:nonref-id (elaborate-ref (attribute v))] - [(bind ~! v:nonref-id ...+) - (group - (for/list ([v (attribute v)]) - (bind - this-syntax - (elaborate-pvar v - (s* bindclass-rep) - "binding class"))))] + [(bind ~! v:nonref-id) + (bind + this-syntax + (elaborate-pvar (attribute v) + (s* bindclass-rep) + "binding class"))] [(bind-syntax ~! v:nonref-id v-transformer:nonref-id) (bind-syntax this-syntax @@ -138,28 +140,24 @@ (elaborate-pvar (attribute v-transformer) (? stxclass-rep?) "syntax class"))] - [(import ~! v:nonref-id ...+) + [(import ~! v:nonref-id) (rec this-syntax - (for/list ([v (attribute v)]) - (elaborate-pvar v + (elaborate-pvar (attribute v) (s* nonterm-rep [variant-info (s* exporting-nonterm-info)]) - "exporting nonterminal")))] - [(re-export ~! v:nonref-id ...+) + "exporting nonterminal"))] + [(re-export ~! v:nonref-id) (re-export this-syntax - (for/list ([v (attribute v)]) - (elaborate-pvar v - (s* nonterm-rep [variant-info (s* exporting-nonterm-info)]) - "exporting nonterminal")))] - [(export ~! v:nonref-id ...+) - (group - (for/list ([v (attribute v)]) - (export - this-syntax - (elaborate-pvar v - (s* bindclass-rep) - "binding class"))))] + (elaborate-pvar (attribute v) + (s* nonterm-rep [variant-info (s* exporting-nonterm-info)]) + "exporting nonterminal"))] + [(export ~! v:nonref-id) + (export + this-syntax + (elaborate-pvar (attribute v) + (s* bindclass-rep) + "binding class"))] [(export-syntax ~! v:nonref-id v-transformer:nonref-id) (export-syntax this-syntax @@ -178,16 +176,21 @@ (elaborate-pvar (attribute v-transformer) (? stxclass-rep?) "syntax class"))] - [(nest ~! v:nonref-id spec:bspec-term) - (nest + [(nest-one ~! v:nonref-id spec:bspec-term) #;(nest v:nonref-id spec:bspec-term) + ; TODO update syntax after old examples work + (nest-one this-syntax (elaborate-pvar (attribute v) (s* nonterm-rep [variant-info (s* nesting-nonterm-info)]) "nesting nonterminal") (elaborate-bspec (attribute spec)))] - [(nest-one ~! v:nonref-id spec:bspec-term) - (nest-one + [(nest ~! v:nonref-id spec:bspec-term) + #;(nest ~! v:nonref-id (~and (~literal ...) ooo) ...+ spec:bspec-term) + ; TODO update syntax after old examples work + (nest this-syntax + 1 + #;(length (attribute ooo)) (elaborate-pvar (attribute v) (s* nonterm-rep [variant-info (s* nesting-nonterm-info)]) "nesting nonterminal") @@ -199,10 +202,22 @@ [(scope ~! spec ...) (scope this-syntax - (group (map elaborate-bspec (attribute spec))))] + (group (elaborate-group (attribute spec))))] [(spec ...) - (group (map elaborate-bspec (attribute spec)))])) + (group (elaborate-group (attribute spec)))])) +; (Listof Syntax) -> (Listof BSpec) +; handles ellipses +(define elaborate-group + (syntax-parser + [(spec (~and ooo (~literal ...)) ... . specs) + ; however many ellipses follow the pattern, wrap the elaborated spec with + ; the ellipses struct that many times. + (cons (for/fold ([spec (elaborate-bspec (attribute spec))]) + ([_ (attribute ooo)]) + (ellipsis spec)) + (elaborate-group (attribute specs)))] + [() '()])) ;; Elaborator helpers @@ -268,16 +283,15 @@ (s* export [pvar (pvar v _)]) (s* nest [pvar (pvar v _)]) (s* nest-one [pvar (pvar v _)]) - (s* suspend [pvar (pvar v _)])) + (s* suspend [pvar (pvar v _)]) + (s* rec [pvar (pvar v _)]) + (s* re-export [pvar (pvar v _)])) (list v)] [(or (s* bind-syntax [pvar (pvar v1 _)] [transformer-pvar (pvar v2 _)]) (s* bind-syntaxes [pvar (pvar v1 _)] [transformer-pvar (pvar v2 _)]) (s* export-syntax [pvar (pvar v1 _)] [transformer-pvar (pvar v2 _)]) (s* export-syntaxes [pvar (pvar v1 _)] [transformer-pvar (pvar v2 _)])) (list v1 v2)] - [(or (s* rec [pvars (list (pvar vs _) ...)]) - (s* re-export [pvars (list (pvar vs _) ...)])) - vs] [_ '()])) (append* node-vars children)) spec)) @@ -359,6 +373,8 @@ (define (check-order/unscoped-expression spec) (define (refs+subexps spec) (match spec + [(s* ellipsis [spec s]) + (refs+subexps s)] [(or (s* ref) (s* suspend)) (void)] [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx)) (binding-scope-error stx)] @@ -380,6 +396,8 @@ (define (check-order/scoped-expression spec) (define (bindings spec specs) (match spec + [(s* ellipsis [spec s]) + (bindings s specs)] [(or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (check-sequence bindings specs)] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) @@ -392,12 +410,16 @@ (define (no-more-recs spec specs) (match spec + [(s* ellipsis [spec s]) + (no-more-recs s specs)] [(and (s* rec) (with-stx stx)) (wrong-syntax/orig stx "only one import binding group may appear in a scope")] [_ (check-sequence refs+subexps (cons spec specs))])) (define (refs+subexps spec specs) (match spec + [(s* ellipsis [spec s]) + (refs+subexps s specs)] [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx)) (wrong-syntax/orig stx "bindings must appear first within a scope")] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) @@ -421,12 +443,16 @@ (define (check-order/exporting spec) (define (exports spec specs) (match spec + [(s* ellipsis [spec s]) + (exports s specs)] [(or (s* export) (s* export-syntax) (s* export-syntaxes)) (check-sequence exports specs)] [_ (check-sequence re-exports (cons spec specs))])) (define (re-exports spec specs) (match spec + [(s* ellipsis [spec s]) + (re-exports s specs)] [(s* re-export) (check-sequence re-exports specs)] [_ @@ -434,6 +460,8 @@ (define (refs+subexps spec specs) (match spec + [(s* ellipsis [spec s]) + (refs+subexps s specs)] [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx)) (binding-scope-error stx)] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) @@ -481,24 +509,24 @@ #`(group (list (bind-syntax '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] [(bind-syntaxes _ (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) #`(group (list (bind-syntaxes '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] - [(rec _ pvars) - (with-syntax ([(s-cp1 ...) (for/list ([pv pvars]) - (match-define (pvar v (nonterm-rep (exporting-nonterm-info pass1-expander _))) pv) - #`(subexp '#,v #,pass1-expander))] - [(s-cp2 ...) (for/list ([pv pvars]) - (match-define (pvar v (nonterm-rep (exporting-nonterm-info _ pass2-expander))) pv) - ;; avoid adding the local-scopes to syntax moved in by first pass expansion - #`(subexp/no-scope '#,v #,pass2-expander))]) - #`(group (list s-cp1 ... s-cp2 ...)))] + [(rec _ pv) + (with-syntax ([s-cp1 (match pv + [(pvar v (nonterm-rep (exporting-nonterm-info pass1-expander _))) + #`(subexp '#,v #,pass1-expander)])] + [s-cp2 (match pv + [(pvar v (nonterm-rep (exporting-nonterm-info _ pass2-expander))) + ;; avoid adding the local-scopes to syntax moved in by first pass expansion + #`(subexp/no-scope '#,v #,pass2-expander)])]) + #`(group (list s-cp1 s-cp2)))] [(or (s* export) (s* export-syntax) (s* export-syntaxes)) (invariant-error 'compile-bspec-term/single-pass)] [(re-export _ (pvar v _)) (invariant-error 'compile-bspec-term/single-pass)] - [(nest _ (pvar v info) spec) + [(nest _ depth (pvar v info) spec) (match info [(nonterm-rep (nesting-nonterm-info expander)) (with-syntax ([spec-c (compile-bspec-term/single-pass spec)]) - #`(nest '#,v #,expander spec-c))])] + #`(nest #,depth '#,v #,expander spec-c))])] [(nest-one _ (pvar v info) spec) (match info [(nonterm-rep (nesting-nonterm-info expander)) @@ -509,7 +537,11 @@ #'(scope spec-c))] [(group specs) (with-syntax ([(spec-c ...) (map compile-bspec-term/single-pass specs)]) - #'(group (list spec-c ...)))])) + #'(group (list spec-c ...)))] + [(ellipsis _ spec) + (define vs (bspec-referenced-pvars spec)) + (with-syntax ([spec-c (compile-bspec-term/single-pass spec)]) + #`(ellipsis #,vs spec-c))])) (define no-op #'(group (list))) @@ -522,7 +554,7 @@ #'(group (list spec-c ...)))] [(or (ref _) - (nest _ _ _) + (nest _ _ _ _) (nest-one _ _ _) (scope _ _) (suspend _ _)) @@ -534,11 +566,13 @@ #`(group (list (bind-syntax '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] [(export-syntaxes _ (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) #`(group (list (bind-syntaxes '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] - [(re-export _ pvars) - (with-syntax ([(s-c ...) (for/list ([pv pvars]) - (match-define (pvar v (nonterm-rep (exporting-nonterm-info pass1-expander _))) pv) - #`(subexp '#,v #,pass1-expander))]) - #`(group (list s-c ...)))])) + [(re-export _ pv) + (match-define (pvar v (nonterm-rep (exporting-nonterm-info pass1-expander _))) pv) + #`(subexp '#,v #,pass1-expander)] + [(ellipsis _ spec) + (define vs (bspec-referenced-pvars spec)) + (with-syntax ([spec-c (compile-bspec-term/pass1 spec)]) + #`(ellipsis #,vs spec-c))])) (define (compile-bspec-term/pass2 spec) (match spec @@ -549,7 +583,7 @@ #'(group (list spec-c ...)))] [(or (ref _) - (nest _ _ _) + (nest _ _ _ _) (nest-one _ _ _) (scope _ _) (suspend _ _)) @@ -557,9 +591,11 @@ [(or (s* export) (s* export-syntax) (s* export-syntaxes)) no-op] - [(re-export _ pvars) - (with-syntax ([(s-c ...) (for/list ([pv pvars]) - (match-define (pvar v (nonterm-rep (exporting-nonterm-info _ pass2-expander))) pv) - ;; avoid adding the local-scopes to syntax moved in by first pass expansion - #`(subexp/no-scope '#,v #,pass2-expander))]) - #`(group (list s-c ...)))])) + [(re-export _ pv) + (match-define (pvar v (nonterm-rep (exporting-nonterm-info _ pass2-expander))) pv) + ;; avoid adding the local-scopes to syntax moved in by first pass expansion + #`(subexp/no-scope '#,v #,pass2-expander)] + [(ellipsis _ spec) + (define vs (bspec-referenced-pvars spec)) + (with-syntax ([spec-c (compile-bspec-term/pass2 spec)]) + #`(ellipsis #,vs spec-c))])) diff --git a/private/test/sequence.rkt b/private/test/sequence.rkt index 18b9a1d..9773c49 100644 --- a/private/test/sequence.rkt +++ b/private/test/sequence.rkt @@ -49,7 +49,7 @@ [(mylang-let* (b ...) e) ; #:binding (fold b e) (define bspec - (nest 'b mylang-expand-binding-group + (nest 1 'b mylang-expand-binding-group (subexp 'e mylang-expand-expr))) (expand-function-return diff --git a/tests/dsls/cmdline/cmdline.rkt b/tests/dsls/cmdline/cmdline.rkt index 730ff32..f3b4434 100644 --- a/tests/dsls/cmdline/cmdline.rkt +++ b/tests/dsls/cmdline/cmdline.rkt @@ -78,7 +78,7 @@ ([option-name:racket-var opt:option] ...) (arg:arg-spec ...) rest:maybe-arg-spec) - #:binding [(export option-name) (re-export arg rest)] + #:binding [(export option-name) (re-export arg) (re-export rest)] #:lhs [#:with ([arg-name _] ...) (attribute arg) #:attr rest-name (syntax-parse (attribute rest) [[rest-name _] #'rest-name] [_ #f]) #'(option-name ... arg-name ... (~? rest-name))] From 6ab6fa991f5914d3e93dd5bc164ba638fd7cc151 Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sat, 3 Aug 2024 21:45:25 -0400 Subject: [PATCH 02/25] ellipses work in tests/dsls/match.rkt --- private/runtime/binding-spec.rkt | 6 +++--- private/syntax/compile/binding-spec.rkt | 10 +++++----- tests/dsls/match.rkt | 2 +- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/private/runtime/binding-spec.rkt b/private/runtime/binding-spec.rkt index b70e25f..fffed99 100644 --- a/private/runtime/binding-spec.rkt +++ b/private/runtime/binding-spec.rkt @@ -320,7 +320,7 @@ ; unsplit the sub-environments and merge that into the initial env. (for/fold ([st st]) ([pv pvs]) - (set-pvar st pv (for/list ([st^ sts^]) (hash-ref st^ pv))))])) + (set-pvar st pv (for/list ([st^ sts^]) (hash-ref (exp-state-pvar-vals st^) pv))))])) ; f is nonterm-transformer ; seq is (listof (treeof syntax?)) @@ -350,8 +350,8 @@ (define (exp-state-split/ellipsis st pvars) (match st [(exp-state pvar-vals nest-state) - (exp-state (env-split/ellipsis pvar-vals pvars) - nest-state)])) + (for/list ([env (env-split/ellipsis pvar-vals pvars)]) + (exp-state env nest-state))])) ; (hash symbol? (treeof syntax?)) (listof symbol?) -> (listof (hash symbol? (treeof syntax?))) ; Spit up the environment into a list of envs. One per element of a pvar's value. diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index 46641f0..294dc28 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -214,8 +214,8 @@ ; however many ellipses follow the pattern, wrap the elaborated spec with ; the ellipses struct that many times. (cons (for/fold ([spec (elaborate-bspec (attribute spec))]) - ([_ (attribute ooo)]) - (ellipsis spec)) + ([ooo (attribute ooo)]) + (ellipsis ooo spec)) (elaborate-group (attribute specs)))] [() '()])) @@ -541,7 +541,7 @@ [(ellipsis _ spec) (define vs (bspec-referenced-pvars spec)) (with-syntax ([spec-c (compile-bspec-term/single-pass spec)]) - #`(ellipsis #,vs spec-c))])) + #`(ellipsis '#,vs spec-c))])) (define no-op #'(group (list))) @@ -572,7 +572,7 @@ [(ellipsis _ spec) (define vs (bspec-referenced-pvars spec)) (with-syntax ([spec-c (compile-bspec-term/pass1 spec)]) - #`(ellipsis #,vs spec-c))])) + #`(ellipsis '#,vs spec-c))])) (define (compile-bspec-term/pass2 spec) (match spec @@ -598,4 +598,4 @@ [(ellipsis _ spec) (define vs (bspec-referenced-pvars spec)) (with-syntax ([spec-c (compile-bspec-term/pass2 spec)]) - #`(ellipsis #,vs spec-c))])) + #`(ellipsis '#,vs spec-c))])) diff --git a/tests/dsls/match.rkt b/tests/dsls/match.rkt index 44dc105..ed5c2a2 100644 --- a/tests/dsls/match.rkt +++ b/tests/dsls/match.rkt @@ -23,7 +23,7 @@ #:binding (scope (import p))) (nonterminal clause [p:pat body:racket-expr ...+] - #:binding (scope (import p) body)) + #:binding (scope (import p) body ...)) (host-interface/expression (match target:racket-expr c:clause ...) #'(with-reference-compilers ([pat-var immutable-reference-compiler]) From b1b76e0a303b614654073ba8b84a5c08ace47bfd Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sat, 3 Aug 2024 22:47:58 -0400 Subject: [PATCH 03/25] ellipsize a bunch of tests --- private/runtime/binding-spec.rkt | 6 +++-- private/syntax/compile/binding-spec.rkt | 27 ++++++++++++++------- tests/basic-langs/block.rkt | 4 +-- tests/basic-langs/define-star.rkt | 2 +- tests/basic-langs/define.rkt | 27 +++++++++++++++++---- tests/basic-langs/expr.rkt | 2 +- tests/basic-langs/mutual-recursion.rkt | 2 +- tests/basic-langs/racket-macro.rkt | 2 +- tests/basic-langs/racket-var.rkt | 2 +- tests/dsls/minikanren.rkt | 2 +- tests/dsls/simply-typed-lambda-calculus.rkt | 10 ++++---- tests/dsls/state-machine-for-tutorial.rkt | 4 +-- 12 files changed, 59 insertions(+), 31 deletions(-) diff --git a/private/runtime/binding-spec.rkt b/private/runtime/binding-spec.rkt index fffed99..acdee12 100644 --- a/private/runtime/binding-spec.rkt +++ b/private/runtime/binding-spec.rkt @@ -61,7 +61,7 @@ (struct rename-bind [pvar space] #:transparent) (struct bind [pvar space bvalc] #:transparent) (struct bind-syntax [pvar space bvalc transformer-pvar] #:transparent) -(struct bind-syntaxes [pvar space bvalc transformer-pvar] #:transparent) +(struct bind-syntaxes [depth pvar space bvalc transformer-pvar] #:transparent) (struct scope [spec] #:transparent) (struct group [specs] #:transparent) (struct nest [depth pvar nonterm spec] #:transparent) @@ -231,7 +231,9 @@ (define scoped-transformer-stx (add-scopes transformer-stx local-scopes)) (let ([bound-id (bind-and-record-rename! (add-scopes id local-scopes) #`(#,constr-id #,(flip-intro-scope scoped-transformer-stx)) space)]) (values scoped-transformer-stx bound-id)))] - [(bind-syntaxes pv space constr-id transformer-pv) + [(bind-syntaxes depth pv space constr-id transformer-pv) + (unless (= 1 depth) + (error "don't know how to handle depth > 1 yet")) (for/pv-state-tree ([transformer-stx transformer-pv] [ids pv]) (when DEBUG-RENAME (displayln 'bind-syntaxes) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index 294dc28..d36d06b 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -53,12 +53,12 @@ (struct ref [pvar] #:transparent) (struct bind with-stx [pvar] #:transparent) (struct bind-syntax with-stx [pvar transformer-pvar] #:transparent) -(struct bind-syntaxes with-stx [pvar transformer-pvar] #:transparent) -(struct rec with-stx [pvar] #:transparent) +(struct bind-syntaxes with-stx [depth pvar transformer-pvar] #:transparent) +(struct rec with-stx [depth pvar] #:transparent) (struct re-export with-stx [pvar] #:transparent) (struct export with-stx [pvar] #:transparent) (struct export-syntax with-stx [pvar transformer-pvar] #:transparent) -(struct export-syntaxes with-stx [pvar transformer-pvar] #:transparent) +(struct export-syntaxes with-stx [depth pvar transformer-pvar] #:transparent) (struct nest with-stx [depth pvar spec] #:transparent) (struct nest-one with-stx [pvar spec] #:transparent) (struct suspend with-stx [pvar] #:transparent) @@ -132,17 +132,22 @@ (? stxclass-rep?) "syntax class"))] [(bind-syntaxes ~! v:nonref-id v-transformer:nonref-id) + #;(bind-syntaxes ~! v:nonref-id (~and ooo (~literal ...)) ... v-transformer:nonref-id) + ; TODO update syntax (bind-syntaxes this-syntax + 1 + #;(length (attribute ooo)) (elaborate-pvar (attribute v) (s* extclass-rep) "extension class") (elaborate-pvar (attribute v-transformer) (? stxclass-rep?) "syntax class"))] - [(import ~! v:nonref-id) + [(import ~! v:nonref-id (~and ooo (~literal ...)) ...) (rec this-syntax + (length (attribute ooo)) (elaborate-pvar (attribute v) (s* nonterm-rep [variant-info (s* exporting-nonterm-info)]) "exporting nonterminal"))] @@ -168,8 +173,12 @@ (? stxclass-rep?) "syntax class"))] [(export-syntaxes ~! v:nonref-id v-transformer:nonref-id) + #;(export-syntaxes ~! v:nonref-id (~and ooo (~literal ...)) ... v-transformer:nonref-id) + ; TODO update syntax (export-syntaxes this-syntax + 1 + #;(length (attribute ooo)) (elaborate-pvar (attribute v) (s* extclass-rep) "extension class") @@ -507,9 +516,9 @@ #`(group (list (bind '#,v '#,space #'#,constr) (rename-bind '#,v '#,space)))] [(bind-syntax _ (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) #`(group (list (bind-syntax '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] - [(bind-syntaxes _ (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) - #`(group (list (bind-syntaxes '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] - [(rec _ pv) + [(bind-syntaxes _ depth (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) + #`(group (list (bind-syntaxes #,depth '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] + [(rec _ _ pv) (with-syntax ([s-cp1 (match pv [(pvar v (nonterm-rep (exporting-nonterm-info pass1-expander _))) #`(subexp '#,v #,pass1-expander)])] @@ -564,8 +573,8 @@ #`(group (list (bind '#,v '#,space #'#,constr) (rename-bind '#,v '#,space)))] [(export-syntax _ (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) #`(group (list (bind-syntax '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] - [(export-syntaxes _ (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) - #`(group (list (bind-syntaxes '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] + [(export-syntaxes _ depth (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) + #`(group (list (bind-syntaxes #,depth '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] [(re-export _ pv) (match-define (pvar v (nonterm-rep (exporting-nonterm-info pass1-expander _))) pv) #`(subexp '#,v #,pass1-expander)] diff --git a/tests/basic-langs/block.rkt b/tests/basic-langs/block.rkt index ca4ee96..a0f2a13 100644 --- a/tests/basic-langs/block.rkt +++ b/tests/basic-langs/block.rkt @@ -13,7 +13,7 @@ #:allow-extension racket-macro ((~literal define-values) (x:racket-var ...) e:racket-expr) - #:binding (export x) + #:binding [(export x) ...] ((~literal define-syntaxes) (x:racket-macro ...) e:expr) #:binding (export-syntaxes x e) @@ -22,7 +22,7 @@ (host-interface/expression (block body:block-form ...) - #:binding (scope (import body)) + #:binding (scope (import body) ...) #'(compile-block body ...))) (define-syntax compile-block diff --git a/tests/basic-langs/define-star.rkt b/tests/basic-langs/define-star.rkt index 5042056..b97a98b 100644 --- a/tests/basic-langs/define-star.rkt +++ b/tests/basic-langs/define-star.rkt @@ -26,7 +26,7 @@ #:binding (nest d tail) (define*-values (v:var ...) e:expr) - #:binding [e (scope (bind v) tail)] + #:binding [e (scope (bind v) ... tail)] e:expr)) diff --git a/tests/basic-langs/define.rkt b/tests/basic-langs/define.rkt index a445804..d3f4877 100644 --- a/tests/basic-langs/define.rkt +++ b/tests/basic-langs/define.rkt @@ -16,10 +16,10 @@ (dsl-+ e1:expr e2:expr) (dsl-lambda (v:var ...) d:def-or-expr ...) - #:binding (scope (bind v) (scope (import d))) + #:binding (scope (bind v) ... (scope (import d ...))) (dsl-letrec-values ([(v:var ...) rhs:expr] ...) d:def-or-expr) - #:binding (scope (bind v) rhs (scope (import d))) + #:binding (scope (bind v) ... ... rhs ... (scope (import d))) (dsl-let* (b:binding ...) e:expr) #:binding (nest b e) @@ -37,10 +37,10 @@ #:allow-extension dsl-macro (dsl-begin d:def-or-expr ...) - #:binding (re-export d) + #:binding [(re-export d) ...] (dsl-define-values (v:var ...) e:expr) - #:binding [(export v) e] + #:binding [(export v) ... e] e:expr)) @@ -52,6 +52,15 @@ ;; tests +(check-equal? + (expand-nonterminal/datum expr + (dsl-lambda () + (dsl-define f (f)) + (f))) + '(dsl-lambda () + (dsl-define-values (f) (f)) + (f))) + (check-equal? (expand-nonterminal/datum expr (dsl-lambda () @@ -64,7 +73,15 @@ (dsl-begin (dsl-define-values (g) (dsl-lambda () (f)))) (f))) - + +(check-equal? + (expand-nonterminal/datum expr + (dsl-letrec-values ([(a b c) (a b c d e f)] + [(d e f) (a b c d e f)]) + (a b c d e f))) + '(dsl-letrec-values ([(a b c) (a b c d e f)] + [(d e f) (a b c d e f)]) + (a b c d e f))) (check-exn #rx"dsl-define-values: identifier already defined" diff --git a/tests/basic-langs/expr.rkt b/tests/basic-langs/expr.rkt index 6e86620..819b696 100644 --- a/tests/basic-langs/expr.rkt +++ b/tests/basic-langs/expr.rkt @@ -13,7 +13,7 @@ (+ e1:expr e2:expr) (let ([v:var e:expr] ...) b:expr) - #:binding [e (scope (bind v) b)] + #:binding [e ... (scope (bind v) ... b)] (let* (b:binding ...) e:expr) #:binding (nest b e)) diff --git a/tests/basic-langs/mutual-recursion.rkt b/tests/basic-langs/mutual-recursion.rkt index 3595351..1ff061d 100644 --- a/tests/basic-langs/mutual-recursion.rkt +++ b/tests/basic-langs/mutual-recursion.rkt @@ -19,7 +19,7 @@ (< e1:expr e2:expr) (vars (v:var ...) e:expr) - #:binding (scope (bind v) e) + #:binding (scope (bind v) ... e) (do s:stmt ... e:expr)) diff --git a/tests/basic-langs/racket-macro.rkt b/tests/basic-langs/racket-macro.rkt index 4acaa0f..cc48be4 100644 --- a/tests/basic-langs/racket-macro.rkt +++ b/tests/basic-langs/racket-macro.rkt @@ -17,7 +17,7 @@ (+ e1:expr e2:expr) (let ([v:var e:expr] ...) b:expr) - #:binding [e (scope (bind v) b)])) + #:binding [e ... (scope (bind v) ... b)])) (define-syntax let* (syntax-rules () diff --git a/tests/basic-langs/racket-var.rkt b/tests/basic-langs/racket-var.rkt index 8dd35a4..b86f194 100644 --- a/tests/basic-langs/racket-var.rkt +++ b/tests/basic-langs/racket-var.rkt @@ -7,7 +7,7 @@ (syntax-spec (nonterminal my-expr ((~literal let) ([x:racket-var e:racket-expr] ...) b:racket-expr) - #:binding (scope (bind x) b)) + #:binding (scope (bind x) ... b)) (host-interface/expression (eval-my-expr e:my-expr) diff --git a/tests/dsls/minikanren.rkt b/tests/dsls/minikanren.rkt index e131acb..78cd45e 100644 --- a/tests/dsls/minikanren.rkt +++ b/tests/dsls/minikanren.rkt @@ -49,7 +49,7 @@ (conj2 g1:goal g2:goal) (fresh1 (x:term-variable ...) b:goal) - #:binding (scope (bind x) b) + #:binding (scope (bind x) ... b) (#%rel-app r:relation-name t:term ...+) diff --git a/tests/dsls/simply-typed-lambda-calculus.rkt b/tests/dsls/simply-typed-lambda-calculus.rkt index 9950dfa..f101ed6 100644 --- a/tests/dsls/simply-typed-lambda-calculus.rkt +++ b/tests/dsls/simply-typed-lambda-calculus.rkt @@ -22,11 +22,11 @@ n:number (#%lambda ([x:typed-var (~datum :) t:type] ...) body:typed-expr) - #:binding (scope (bind x) body) + #:binding (scope (bind x) ... body) (#%app fun:typed-expr arg:typed-expr ...) (#%let ([x:typed-var e:typed-expr] ...) body:typed-expr) - #:binding (scope (bind x) body) + #:binding (scope (bind x) ... body) ; type annotation (~> (e (~datum :) t) @@ -36,7 +36,7 @@ (rkt e:racket-expr (~datum :) t:type) (block d:typed-definition-or-expr ... e:typed-expr) - #:binding (scope (import d) e) + #:binding (scope (import d ...) e) ; rewrite for tagging applications (~> (fun arg ...) @@ -50,7 +50,7 @@ (#%define x:typed-var t:type e:typed-expr) #:binding (export x) (begin defn:typed-definition-or-expr ...+) - #:binding (re-export defn) + #:binding [(re-export defn) ...] e:typed-expr) (host-interface/expression (stlc/expr e:typed-expr) @@ -63,7 +63,7 @@ #`'#,t-datum) (host-interface/definitions (stlc body:typed-definition-or-expr ...+) - #:binding (re-export body) + #:binding [(re-export body) ...] (type-check-defn-or-expr/pass1 #'(begin body ...)) (type-check-defn-or-expr/pass2 #'(begin body ...)) #'(compile-defn-or-expr/top (begin body ...))) diff --git a/tests/dsls/state-machine-for-tutorial.rkt b/tests/dsls/state-machine-for-tutorial.rkt index 16be781..dd30579 100644 --- a/tests/dsls/state-machine-for-tutorial.rkt +++ b/tests/dsls/state-machine-for-tutorial.rkt @@ -24,11 +24,11 @@ body:racket-expr ... ((~datum goto) next-state-name:state-name)) - #:binding (scope (bind arg) body)) + #:binding (scope (bind arg) ... body ...)) (host-interface/expression (machine #:initial initial-state:state-name s:state-spec ...) - #:binding (scope (import s) initial-state) + #:binding (scope (import s ...) initial-state) (check-for-inaccessible-states #'initial-state (attribute s)) #'(compile-machine initial-state s ...))) From 54a7dd509d0672ac193e18a90e0b3580098b6ca0 Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Thu, 22 Aug 2024 22:22:26 -0400 Subject: [PATCH 04/25] disallow multiple ellipses in import --- private/syntax/compile/binding-spec.rkt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index d36d06b..a2e72b8 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -145,6 +145,9 @@ (? stxclass-rep?) "syntax class"))] [(import ~! v:nonref-id (~and ooo (~literal ...)) ...) + (define depth (length (attribute ooo))) + (when (> depth 1) + (wrong-syntax/orig this-syntax "import cannot contain more than one ellipsis")) (rec this-syntax (length (attribute ooo)) From 5bd56e2d62a698c49fa09cf36299bfed264412c7 Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Thu, 29 Aug 2024 11:56:24 -0400 Subject: [PATCH 05/25] runtime support for nest-one in nest --- private/runtime/binding-spec.rkt | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/private/runtime/binding-spec.rkt b/private/runtime/binding-spec.rkt index acdee12..eea76c6 100644 --- a/private/runtime/binding-spec.rkt +++ b/private/runtime/binding-spec.rkt @@ -281,18 +281,23 @@ (simple-expand-internal spec st local-scopes))] [(nest depth pv f inner-spec) - (unless (= 1 depth) + (unless (< 1 depth) (error "don't know how to handle depth > 1 yet")) - (define init-seq (get-pvar st pv)) + (define init-seq (if (= 0 depth) + (list (get-pvar st pv)) + (get-pvar st pv))) (define res (start-nest f init-seq st inner-spec local-scopes)) (match-define (nest-ret done-seq st^) res) - (set-pvar st^ pv done-seq)] + (set-pvar st^ pv (if (= 0 depth) + (car done-seq) + done-seq))] + ; TODO deprecate [(nest-one pv f inner-spec) (define init-seq (list (get-pvar st pv))) From 81345e59db97bb35cf441e64f7861b0fbfcc2a50 Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Thu, 29 Aug 2024 18:04:58 -0400 Subject: [PATCH 06/25] allow multiple imports, combine them, and ellipses outside of import to inside --- private/runtime/binding-spec.rkt | 2 +- private/syntax/compile/binding-spec.rkt | 103 +++++++++++++++++------- tests/basic-langs/block.rkt | 2 +- tests/errors.rkt | 22 +++-- tests/multi-import.rkt | 32 ++++++++ 5 files changed, 122 insertions(+), 39 deletions(-) create mode 100644 tests/multi-import.rkt diff --git a/private/runtime/binding-spec.rkt b/private/runtime/binding-spec.rkt index eea76c6..3cbd41f 100644 --- a/private/runtime/binding-spec.rkt +++ b/private/runtime/binding-spec.rkt @@ -281,7 +281,7 @@ (simple-expand-internal spec st local-scopes))] [(nest depth pv f inner-spec) - (unless (< 1 depth) + (when (> depth 1) (error "don't know how to handle depth > 1 yet")) (define init-seq (if (= 0 depth) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index a2e72b8..4c22ad0 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -32,16 +32,17 @@ (check-affine-pvar-use! bspec-elaborated) (define bspec-with-implicits (add-implicit-pvar-refs bspec-elaborated bound-pvars)) (define bspec-flattened (bspec-flatten-groups bspec-with-implicits)) + (define bspec-combined-recs (bspec-combine-recs bspec-flattened)) (syntax-parse variant [(~or #:simple (#:nesting _)) - (check-order/unscoped-expression bspec-flattened) - (compile-bspec-term/single-pass bspec-flattened)] + (check-order/unscoped-expression bspec-combined-recs) + (compile-bspec-term/single-pass bspec-combined-recs)] [#:pass1 - (check-order/exporting bspec-flattened) - (compile-bspec-term/pass1 bspec-flattened)] + (check-order/exporting bspec-combined-recs) + (compile-bspec-term/pass1 bspec-combined-recs)] [#:pass2 - #`(fresh-env-expr-ctx #,(compile-bspec-term/pass2 bspec-flattened))])) + #`(fresh-env-expr-ctx #,(compile-bspec-term/pass2 bspec-combined-recs))])) ;; Elaborated representation; variables are associated with expander-environment information @@ -55,6 +56,9 @@ (struct bind-syntax with-stx [pvar transformer-pvar] #:transparent) (struct bind-syntaxes with-stx [depth pvar transformer-pvar] #:transparent) (struct rec with-stx [depth pvar] #:transparent) +; no surface syntax, just a mechanism to combine recs +; something like [(import x) (import y)] ~> (recs (list (rec x) (rec y))) +(struct recs [specs] #:transparent) (struct re-export with-stx [pvar] #:transparent) (struct export with-stx [pvar] #:transparent) (struct export-syntax with-stx [pvar transformer-pvar] #:transparent) @@ -87,6 +91,9 @@ [(group ss) (let ([ss^ (map (lambda (s) (map-bspec f s)) ss)]) (f (group ss^)))] + [(recs ss) + (let ([ss^ (map (lambda (s) (map-bspec f s)) ss)]) + (f (recs ss^)))] [(ellipsis stx s) (f (ellipsis stx (map-bspec f s)))] [_ (f spec)])) @@ -101,7 +108,7 @@ (s* ellipsis [spec s])) (let ([s^ (fold-bspec f s)]) (f spec (list s^)))] - [(group ss) + [(or (recs ss) (group ss)) (let ([ss^ (map (lambda (s) (fold-bspec f s)) ss)]) (f spec ss^))] [_ (f spec '())])) @@ -222,6 +229,11 @@ ; handles ellipses (define elaborate-group (syntax-parser + #:datum-literals (import) + [((import v:id (~and ooo/inside (~literal ...)) ...) (~and ooo/outside (~literal ...)) ... . specs) + ; move ellipses outside of import into the import + (cons (elaborate-bspec #'(import v ooo/inside ... ooo/outside ...)) + (elaborate-group (attribute specs)))] [(spec (~and ooo (~literal ...)) ... . specs) ; however many ellipses follow the pattern, wrap the elaborated spec with ; the ellipses struct that many times. @@ -323,6 +335,22 @@ [(group l) l] [_ (list el)])) +; combine consecutive recs in a group +(define (bspec-combine-recs bspec) + (map-bspec + (lambda (spec) + (match spec + [(group l) + (group (let loop ([l l]) + (match l + [(list (and rs (s* rec)) ..1 ss ...) + (cons (recs rs) (loop ss))] + [(cons s ss) + (cons s (loop ss))] + [(list) (list)])))] + [_ spec])) + bspec)) + ;; Static checks ; Concerns: @@ -336,14 +364,14 @@ ; - Bindings should come before rec and references within a scope ; - Exports may only occur at the top-level of a exporting non-terminal, ; and appear before rec and references -; - Only one `import` group should appear in a scope, after bindings and before +; - Imports can appear after bindings and before ; references. ; ; Resulting contexts: ; - Unscoped expression context; references only. ; - Scoped expression context ; - Bindings -; - Then one import +; - Then imports ; - Then references ; - Exporting context ; - Exports @@ -358,7 +386,7 @@ ; exporting-spec: (seq (* (or (export _) (export-syntax _ _) (export-syntaxes _ _))) (* (re-export _)) refs+subexps) ; unscoped-spec: refs+subexps ; refs+subexps: (* (or (ref _) (nest _ unscoped-spec) (nest-one _ unscoped-spec) (scope scoped-spec))) -; scoped-spec: (seq (* (or (bind-syntax _ _) (bind-syntaxes _ _) (bind _))) (? (rec _)) refs+subexps) +; scoped-spec: (seq (* (or (bind-syntax _ _) (bind-syntaxes _ _) (bind _))) (? (recs _)) refs+subexps) ; ; The implementation below separately implements refs+subexps for each context in which it occurs to ; provide specific error messages. @@ -390,8 +418,12 @@ [(or (s* ref) (s* suspend)) (void)] [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx)) (binding-scope-error stx)] - [(and (s* rec) (with-stx stx)) + [(or (and (s* rec) (with-stx stx)) + (recs (cons (and (s* rec) (with-stx stx)) _))) (wrong-syntax/orig stx "import binding groups must occur within a scope")] + [(recs (list)) + ; impossible + (void)] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) (export-context-error stx)] [(and (s* re-export) (with-stx stx)) @@ -417,15 +449,9 @@ [(and (s* re-export) (with-stx stx)) (re-export-context-error stx)] [(s* rec) - (check-sequence no-more-recs specs)] - [_ (check-sequence refs+subexps (cons spec specs))])) - - (define (no-more-recs spec specs) - (match spec - [(s* ellipsis [spec s]) - (no-more-recs s specs)] - [(and (s* rec) (with-stx stx)) - (wrong-syntax/orig stx "only one import binding group may appear in a scope")] + (check-sequence refs+subexps specs)] + [(s* recs) + (check-sequence refs+subexps specs)] [_ (check-sequence refs+subexps (cons spec specs))])) (define (refs+subexps spec specs) @@ -438,8 +464,12 @@ (export-context-error stx)] [(and (s* re-export) (with-stx stx)) (re-export-context-error stx)] - [(and (s* rec) (with-stx stx)) + [(or (and (s* rec) (with-stx stx)) + (recs (cons (and (s* rec) (with-stx stx)) _))) (wrong-syntax/orig stx "an import binding group must appear before references and subexpressions")] + [(recs (list)) + ; impossible + (void)] [(or (s* ref) (s* suspend)) (check-sequence refs+subexps specs)] [(or (s* nest [spec s]) @@ -480,8 +510,12 @@ (wrong-syntax/orig stx "exports must appear first in a exporting spec")] [(and (s* re-export) (with-stx stx)) (wrong-syntax/orig stx "re-exports must occur before references and subexpressions")] - [(and (s* rec) (with-stx stx)) + [(or (and (s* rec) (with-stx stx)) + (recs (cons (and (s* rec) (with-stx stx)) _))) (wrong-syntax/orig stx "import must occur within a scope")] + [(recs (list)) + ; impossible + (void)] [(or (s* ref) (s* suspend)) (check-sequence refs+subexps specs)] [(or (s* nest [spec s]) @@ -521,15 +555,24 @@ #`(group (list (bind-syntax '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] [(bind-syntaxes _ depth (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) #`(group (list (bind-syntaxes #,depth '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] - [(rec _ _ pv) - (with-syntax ([s-cp1 (match pv - [(pvar v (nonterm-rep (exporting-nonterm-info pass1-expander _))) - #`(subexp '#,v #,pass1-expander)])] - [s-cp2 (match pv - [(pvar v (nonterm-rep (exporting-nonterm-info _ pass2-expander))) - ;; avoid adding the local-scopes to syntax moved in by first pass expansion - #`(subexp/no-scope '#,v #,pass2-expander)])]) - #`(group (list s-cp1 s-cp2)))] + [(recs ss) + (match ss + [(list (rec _ _ pvs) ...) + (define/syntax-parse (s-cp1 ...) + (for/list ([pv pvs]) + (match pv + [(pvar v (nonterm-rep (exporting-nonterm-info pass1-expander _))) + #`(subexp '#,v #,pass1-expander)]))) + (define/syntax-parse (s-cp2 ...) + (for/list ([pv pvs]) + (match pv + [(pvar v (nonterm-rep (exporting-nonterm-info _ pass2-expander))) + ;; avoid adding the local-scopes to syntax moved in by first pass expansion + #`(subexp/no-scope '#,v #,pass2-expander)]))) + #'(group (list s-cp1 ... s-cp2 ...))] + [_ (error "unexpected specs in recs")])] + [(rec _ _ _) + (error "shouldn't encounter rec")] [(or (s* export) (s* export-syntax) (s* export-syntaxes)) (invariant-error 'compile-bspec-term/single-pass)] [(re-export _ (pvar v _)) diff --git a/tests/basic-langs/block.rkt b/tests/basic-langs/block.rkt index a0f2a13..2e534c1 100644 --- a/tests/basic-langs/block.rkt +++ b/tests/basic-langs/block.rkt @@ -22,7 +22,7 @@ (host-interface/expression (block body:block-form ...) - #:binding (scope (import body) ...) + #:binding (scope (import body ...)) #'(compile-block body ...))) (define-syntax compile-block diff --git a/tests/errors.rkt b/tests/errors.rkt index b6d6023..8496d42 100644 --- a/tests/errors.rkt +++ b/tests/errors.rkt @@ -149,15 +149,23 @@ #:binding (scope e (import d))))) (check-decl-error - #rx"nonterminal: only one import binding group may appear in a scope" + #rx"import cannot contain more than one ellipsis" (syntax-spec - (binding-class var) - (nonterminal/exporting def - (define x:var e:expr) - #:binding [(export x) e]) + (nonterminal/exporting decl + ()) + (nonterminal expr + (m (d:decl (... ...)) (... ...)) + #:binding (import d (... ...) (... ...))))) + +(check-decl-error + #rx"import cannot contain more than one ellipsis" + (syntax-spec + (nonterminal/exporting decl + ()) (nonterminal expr - (block d1:def d2:def) - #:binding (scope (import d1) (import d2))))) + (m (d:decl (... ...)) (... ...)) + ; this one tests that we get the error even on [(import ...) ...] ~> (import ... ...) + #:binding [(import d (... ...)) (... ...)]))) (check-decl-error #rx"exports must appear first in a exporting spec" diff --git a/tests/multi-import.rkt b/tests/multi-import.rkt new file mode 100644 index 0000000..c18dee4 --- /dev/null +++ b/tests/multi-import.rkt @@ -0,0 +1,32 @@ +#lang racket/base + +; testing the combining of multiple imports into a single import group + +(require "../testing.rkt") + +(syntax-spec + (nonterminal/exporting defn + ((~literal define) x:racket-var e:racket-expr) + #:binding [(export x)]) + + (host-interface/expression + (double-local ([d1:defn ...] [d2:defn ...]) body:racket-expr) + #:binding (scope (import d1 ...) (import d2 ...) body) + #'(compile-expr ([d1 ...] [d2 ...]) body))) + +(define-syntax compile-expr + (syntax-parser + #:literals (define) + [(_ ([(define x1 e1) ...] [(define x2 e2) ...]) body) + #'(let () + (define x1 e1) + ... + (define x2 e2) + ... + body)])) + +(check-equal? + (double-local ([(define odd? (lambda (n) (if (zero? n) #f (even? (sub1 n)))))] + [(define even? (lambda (n) (or (zero? n) (odd? (sub1 n)))))]) + (odd? 3)) + #t) From d2d935b8c3a7ec6617638e545d92995d8c9c035f Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Tue, 17 Sep 2024 18:37:16 -0400 Subject: [PATCH 07/25] mandatory ellipses, nest-one -> nest fixes #32 --- demos/minimal-state-machine/state-machine.rkt | 4 +- demos/visser-symposium/state-machine.rkt | 4 +- design/statecharts-full.rkt | 6 +- design/statecharts-smaller.rkt | 6 +- private/runtime/binding-spec.rkt | 4 +- private/syntax/compile/binding-spec.rkt | 62 +++++++++++++++++-- .../syntax/compile/nonterminal-expander.rkt | 2 +- private/syntax/compile/syntax-spec.rkt | 12 ++-- private/syntax/env-reps.rkt | 2 +- testing.rkt | 7 ++- tests/basic-langs/bind-syntax.rkt | 14 ++--- tests/basic-langs/define-star.rkt | 4 +- tests/basic-langs/define.rkt | 2 +- tests/basic-langs/expr.rkt | 2 +- tests/basic-langs/simple-match.rkt | 4 +- tests/binding-operations.rkt | 2 +- tests/dsls/baby-peg.rkt | 2 +- tests/dsls/cmdline/cmdline.rkt | 4 +- tests/dsls/js/js.rkt | 8 +-- tests/dsls/miniclass/class.rkt | 6 +- .../dsls/minikanren-binding-space-compile.rkt | 2 +- tests/dsls/minikanren-binding-space.rkt | 2 +- tests/dsls/minikanren-compile-defs.rkt | 8 +-- tests/dsls/minikanren-compile.rkt | 2 +- tests/dsls/minikanren-rs2e/mk.rkt | 5 +- tests/dsls/peg.rkt | 16 ++--- tests/dsls/peg/core.rkt | 18 +++--- tests/dsls/peg2.rkt | 12 ++-- tests/dsls/qi-core.rkt | 4 +- tests/dsls/simply-typed-lambda-calculus.rkt | 2 +- tests/dsls/state-machine-oo/state-machine.rkt | 4 +- tests/dsls/statecharts/statecharts.rkt | 14 ++--- tests/dsls/stlc-on-typed-racket.rkt | 2 +- tests/dsls/tiny-hdl/hdl.rkt | 6 +- tests/dsls/typed-peg/core.rkt | 18 +++--- tests/errors.rkt | 34 ++++++++-- tests/nest-use-site-scope.rkt | 6 +- tests/nested-with-reference-compilers.rkt | 4 +- tests/symbol-collections.rkt | 4 +- 39 files changed, 197 insertions(+), 123 deletions(-) diff --git a/demos/minimal-state-machine/state-machine.rkt b/demos/minimal-state-machine/state-machine.rkt index 1d90c0d..423c43c 100644 --- a/demos/minimal-state-machine/state-machine.rkt +++ b/demos/minimal-state-machine/state-machine.rkt @@ -10,7 +10,7 @@ (host-interface/expression (machine #:initial-state s:state-name d:machine-decl ...) - #:binding (scope (import d) s) + #:binding (scope (import d ...) s) #'(compile-machine s d ...)) (nonterminal/exporting machine-decl @@ -23,7 +23,7 @@ (on (evt:id arg:event-var ...) e:racket-expr ... ((~datum ->) s:state-name)) - #:binding (scope (bind arg) e))) + #:binding (scope (bind arg) ... e ...))) (require syntax/parse/define (for-syntax syntax/parse racket/list)) diff --git a/demos/visser-symposium/state-machine.rkt b/demos/visser-symposium/state-machine.rkt index 1b2cd3d..5f6c609 100644 --- a/demos/visser-symposium/state-machine.rkt +++ b/demos/visser-symposium/state-machine.rkt @@ -9,7 +9,7 @@ (host-interface/expression (machine #:initial-state s:state-name d:machine-decl ...) - #:binding (scope (import d) s) + #:binding (scope (import d ...) s) #'(compile-machine s d ...)) (nonterminal/exporting machine-decl @@ -23,4 +23,4 @@ (on (evt:id arg:racket-var ...) e:racket-expr ... ((~datum ->) s:state-name)) - #:binding (scope (bind arg) e))) \ No newline at end of file + #:binding (scope (bind arg) ... e ...))) diff --git a/design/statecharts-full.rkt b/design/statecharts-full.rkt index 25247ac..ab4ed13 100644 --- a/design/statecharts-full.rkt +++ b/design/statecharts-full.rkt @@ -19,7 +19,7 @@ (state n:state-name sb:state-body ...) - #:binding [(export n) (scope (import sb))] + #:binding [(export n) (scope (import sb) ...)] (use scn:statechart-name #:as sn:state-name e:event ...)) @@ -27,7 +27,7 @@ (nonterminal event (on (evt:id arg:var ...) ab:action ...+) - #:binding (scope (bind arg) ab) + #:binding (scope (bind arg) ... ab ...) (on-enter ab:action ...) (on-exit ab:action ...)) @@ -40,7 +40,7 @@ (emit (name:id arg:racket-expr ...)) (let* (b:binding-group ...) body:action ...) - #:binding (nest b body)) + #:binding (nest b ... [body ...])) (nonterminal/nesting binding-group (tail) [v:var e:racket-expr] diff --git a/design/statecharts-smaller.rkt b/design/statecharts-smaller.rkt index e25e539..f8c0aa3 100644 --- a/design/statecharts-smaller.rkt +++ b/design/statecharts-smaller.rkt @@ -16,7 +16,7 @@ (state n:state-name sb:state-body ...) - #:binding [(export n) (scope (import sb))] + #:binding [(export n) (scope (import sb) ...)] (use scn:statechart-name #:as sn:state-name e:event ...)) @@ -24,7 +24,7 @@ (nonterminal event (on (evt:id arg:var ...) ab:action ...+) - #:binding (scope (bind arg) ab)) + #:binding (scope (bind arg) ... ab)) (nonterminal action (-> s:state-name) @@ -34,7 +34,7 @@ (emit (name:id arg:racket-expr ...)) (let* (b:binding-group ...) body:action ...) - #:binding (nest b body)) + #:binding (nest b ... body)) (nonterminal/nesting binding-group (tail) [v:var e:racket-expr] diff --git a/private/runtime/binding-spec.rkt b/private/runtime/binding-spec.rkt index 3cbd41f..456c1be 100644 --- a/private/runtime/binding-spec.rkt +++ b/private/runtime/binding-spec.rkt @@ -389,14 +389,14 @@ (or (for/first ([(_ vs) (in-hash env)]) (unless (list? vs) ; TODO check in compiler - (error "too many ellipses in template")) + (error "too many ellipses in binding spec")) (length vs)) 0)) (for ([(_ vs) (in-hash env)]) (unless (= (length vs) result) ; TODO Can this be checked in the compiler? Would need to make sure ellipsized bs vars ; come from the same ss ellipsis. - (error "incompatible ellipsis match counts for template"))) + (error "incompatible ellipsis match counts for binding spec"))) result) (module+ test diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index 4c22ad0..75bc05d 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -30,6 +30,7 @@ (define bspec-elaborated (elaborate-bspec bspec-stx)) (check-affine-pvar-use! bspec-elaborated) + (check-ellipsis-depth bspec-elaborated) (define bspec-with-implicits (add-implicit-pvar-refs bspec-elaborated bound-pvars)) (define bspec-flattened (bspec-flatten-groups bspec-with-implicits)) (define bspec-combined-recs (bspec-combine-recs bspec-flattened)) @@ -195,7 +196,8 @@ (elaborate-pvar (attribute v-transformer) (? stxclass-rep?) "syntax class"))] - [(nest-one ~! v:nonref-id spec:bspec-term) #;(nest v:nonref-id spec:bspec-term) + [#;(nest-one ~! v:nonref-id spec:bspec-term) + (nest v:nonref-id spec:bspec-term) ; TODO update syntax after old examples work (nest-one this-syntax @@ -203,13 +205,11 @@ (s* nonterm-rep [variant-info (s* nesting-nonterm-info)]) "nesting nonterminal") (elaborate-bspec (attribute spec)))] - [(nest ~! v:nonref-id spec:bspec-term) - #;(nest ~! v:nonref-id (~and (~literal ...) ooo) ...+ spec:bspec-term) - ; TODO update syntax after old examples work + [#;(nest ~! v:nonref-id spec:bspec-term) + (nest ~! v:nonref-id (~and (~literal ...) ooo) ...+ spec:bspec-term) (nest this-syntax - 1 - #;(length (attribute ooo)) + (length (attribute ooo)) (elaborate-pvar (attribute v) (s* nonterm-rep [variant-info (s* nesting-nonterm-info)]) "nesting nonterminal") @@ -278,6 +278,14 @@ (wrong-syntax v "expected a reference to a pattern variable"))) (pvar-rep-var-info binding)) +(define (lookup-pvar-depth v) + (define binding (lookup v pvar-rep?)) + (when (not binding) + (if (identifier? (current-syntax-context)) + (wrong-syntax/orig v "binding spec expected a reference to a pattern variable") + (wrong-syntax v "expected a reference to a pattern variable"))) + (pvar-rep-depth binding)) + (define (check-affine-pvar-use! bspec) (define pvars (bspec-referenced-pvars bspec)) (define maybe-dup (check-duplicates pvars free-identifier=?)) @@ -285,6 +293,48 @@ (when maybe-dup (wrong-syntax/orig maybe-dup "each pattern variable must occur in the binding spec at most once"))) +(define (check-ellipsis-depth bspec) + (let loop ([bspec bspec] [depth 0]) + (match bspec + [(ref (pvar v _)) + (check-ellipsis-depth/pvar depth v)] + [(or (export stx (pvar v _)) + (re-export stx (pvar v _)) + (bind stx (pvar v _)) + (suspend stx (pvar v _))) + (check-ellipsis-depth/pvar depth v stx)] + [(or (export-syntax stx (pvar v _) (pvar tv _)) + (bind-syntax stx (pvar v _) (pvar tv _))) + (check-ellipsis-depth/pvar depth v stx) + (check-ellipsis-depth/pvar depth tv stx)] + [(or (export-syntaxes stx v-depth (pvar v _) (pvar tv _)) + (bind-syntaxes stx v-depth (pvar v _) (pvar tv _))) + (check-ellipsis-depth/pvar (+ v-depth depth) v stx) + (check-ellipsis-depth/pvar depth tv stx)] + [(rec stx rec-depth (pvar v _)) + (check-ellipsis-depth/pvar (+ rec-depth depth) v stx)] + [(or (group ss) (recs ss)) + (for ([s ss]) + (loop s depth))] + [(nest stx nest-depth (pvar v _) s) + (check-ellipsis-depth/pvar (+ nest-depth depth) v stx) + (loop s depth)] + [(nest-one stx (pvar v _) s) + (check-ellipsis-depth/pvar depth v stx) + (loop s depth)] + [(scope _ s) + (loop s depth)] + [(ellipsis _ s) + (loop s (add1 depth))]))) + +(define (check-ellipsis-depth/pvar bs-depth v [stx #f]) + (define ss-depth (lookup-pvar-depth v)) + (cond + [(< ss-depth bs-depth) + (wrong-syntax/orig v "too many ellipses for pattern variable in binding spec")] + [(< bs-depth ss-depth) + (wrong-syntax/orig v "missing ellipses with pattern variable in binding spec")])) + ;; Infer implicit pvar refs (define (add-implicit-pvar-refs bspec bound-pvars) diff --git a/private/syntax/compile/nonterminal-expander.rkt b/private/syntax/compile/nonterminal-expander.rkt index cb4964d..00be156 100644 --- a/private/syntax/compile/nonterminal-expander.rkt +++ b/private/syntax/compile/nonterminal-expander.rkt @@ -49,7 +49,7 @@ (syntax-parse (attribute variant) [(#:nesting nested-id:id) (with-scope sc - (define id^ (bind! (add-scope (attribute nested-id) sc) (pvar-rep (nested-binding)))) + (define id^ (bind! (add-scope (attribute nested-id) sc) (pvar-rep (nested-binding) 0))) #`(wrap-hygiene (lambda (stx-a) #,(generate-loop (add-scope #'(prod-arg ...) sc) id^ #'stx-a)) diff --git a/private/syntax/compile/syntax-spec.rkt b/private/syntax/compile/syntax-spec.rkt index 515bfa6..dad0aa3 100644 --- a/private/syntax/compile/syntax-spec.rkt +++ b/private/syntax/compile/syntax-spec.rkt @@ -134,17 +134,17 @@ (define res '()) ;; records left-to-right - (let rec ([stx stx]) + (let rec ([stx stx] [depth 0]) (syntax-parse stx #:context 'extract-var-mapping - [(a . d) - (rec #'a) - (rec #'d)] + [(a (~and ooo (~or (~literal ...) (~literal ...+))) ... . d) + (rec #'a (+ depth (length (attribute ooo)))) + (rec #'d depth)] [r:ref-id #:with c:special-syntax-class #'r.ref (when (member #'r.var res bound-identifier=?) (wrong-syntax/orig #'r.ref "duplicate pattern variable")) - (bind! #'r.var (pvar-rep (special-syntax-class-binding))) + (bind! #'r.var (pvar-rep (special-syntax-class-binding) depth)) (set! res (cons #'r.var res))] [r:ref-id (define binding (lookup #'r.ref @@ -157,7 +157,7 @@ (wrong-syntax/orig #'r.ref "expected a reference to a binding class, extension class, syntax class, or nonterminal")) (when (member #'r.var res bound-identifier=?) (wrong-syntax/orig #'r.ref "duplicate pattern variable")) - (bind! #'r.var (pvar-rep binding)) + (bind! #'r.var (pvar-rep binding depth)) (set! res (cons #'r.var res))] [_ (void)])) diff --git a/private/syntax/env-reps.rkt b/private/syntax/env-reps.rkt index e98cded..004a452 100644 --- a/private/syntax/env-reps.rkt +++ b/private/syntax/env-reps.rkt @@ -74,7 +74,7 @@ ; bindclass-rep ; nonterm-rep ; nested-binding -(struct pvar-rep (var-info)) +(struct pvar-rep (var-info depth)) (struct nested-binding []) (struct special-syntax-class-binding []) diff --git a/testing.rkt b/testing.rkt index 933f0f5..270d92f 100644 --- a/testing.rkt +++ b/testing.rkt @@ -35,9 +35,10 @@ (check-exn (check-formatted-error-matches rx) (lambda () - (eval-syntax #`(module m racket/base - (require "../main.rkt") - decl-stx))))) + (eval-syntax (quote-syntax + (module m racket/base + (require "../main.rkt") + decl-stx)))))) (define-syntax-rule (check-phase1-error rx e) (check-exn diff --git a/tests/basic-langs/bind-syntax.rkt b/tests/basic-langs/bind-syntax.rkt index 846aad8..c4a48f0 100644 --- a/tests/basic-langs/bind-syntax.rkt +++ b/tests/basic-langs/bind-syntax.rkt @@ -17,10 +17,10 @@ n:number ((~literal +) e:racket-like-expr ...) (racket-letrec-syntax ([v:racket-macro e:expr] ...) b:racket-like-expr) - #:binding (scope (bind-syntax v e) b) + #:binding (scope (bind-syntax v e) ... b) (racket-letrec-syntaxes ([(v:racket-macro ...) e:expr] ...) b:racket-like-expr) - #:binding (scope (bind-syntaxes v e) b) + #:binding (scope (bind-syntaxes v e) ... b) e:racket-expr) (host-interface/expression @@ -50,21 +50,21 @@ ((~literal +) e:my-expr ...) (my-let ([v:my-var e:my-expr] ...) b:my-expr) - #:binding (scope (bind v) b) + #:binding (scope (bind v) ... b) (my-letrec-syntax ([v:my-macro e:expr] ...) b:my-expr) - #:binding (scope (bind-syntax v e) b) + #:binding (scope (bind-syntax v e) ... b) (my-letrec-syntaxes ([(v:my-macro ...) e:expr] ...) b:my-expr) - #:binding (scope (bind-syntaxes v e) b) + #:binding (scope (bind-syntaxes v e) ... b) ; this binds racket-macros, which cannot be used in my-exprs ; uses of bound macros should error. (bad-my-letrec-syntax ([v:racket-macro e:expr] ...) b:my-expr) - #:binding (scope (bind-syntax v e) b) + #:binding (scope (bind-syntax v e) ... b) (bad-my-letrec-syntaxes ([(v:racket-macro ...) e:expr] ...) b:my-expr) - #:binding (scope (bind-syntaxes v e) b)) + #:binding (scope (bind-syntaxes v e) ... b)) (host-interface/expression (my-lang e:my-expr) diff --git a/tests/basic-langs/define-star.rkt b/tests/basic-langs/define-star.rkt index b97a98b..77c5a91 100644 --- a/tests/basic-langs/define-star.rkt +++ b/tests/basic-langs/define-star.rkt @@ -16,14 +16,14 @@ (+ e1:expr e2:expr) (block d:def-or-expr ...) - #:binding (nest d [])) + #:binding (nest d ... [])) (nonterminal/nesting def-or-expr (tail) #:description "mylang definition context" #:allow-extension mylang-macro (begin d:def-or-expr ...) - #:binding (nest d tail) + #:binding (nest d ... tail) (define*-values (v:var ...) e:expr) #:binding [e (scope (bind v) ... tail)] diff --git a/tests/basic-langs/define.rkt b/tests/basic-langs/define.rkt index d3f4877..b80e2a4 100644 --- a/tests/basic-langs/define.rkt +++ b/tests/basic-langs/define.rkt @@ -22,7 +22,7 @@ #:binding (scope (bind v) ... ... rhs ... (scope (import d))) (dsl-let* (b:binding ...) e:expr) - #:binding (nest b e) + #:binding (nest b ... e) (v:var e:expr ...)) diff --git a/tests/basic-langs/expr.rkt b/tests/basic-langs/expr.rkt index 819b696..05721de 100644 --- a/tests/basic-langs/expr.rkt +++ b/tests/basic-langs/expr.rkt @@ -16,7 +16,7 @@ #:binding [e ... (scope (bind v) ... b)] (let* (b:binding ...) e:expr) - #:binding (nest b e)) + #:binding (nest b ... e)) (nonterminal/nesting binding (nested) #:description "let* binding group" diff --git a/tests/basic-langs/simple-match.rkt b/tests/basic-langs/simple-match.rkt index eb488fc..cf7ede3 100644 --- a/tests/basic-langs/simple-match.rkt +++ b/tests/basic-langs/simple-match.rkt @@ -27,7 +27,7 @@ #:description "mylang match clause" [p:pat rhs:expr] - #:binding (nest-one p rhs)) + #:binding (nest p rhs)) (nonterminal/nesting pat (nested) #:description "mylang match pattern" @@ -38,7 +38,7 @@ (pempty) (pcons p1:pat p2:pat) - #:binding (nest-one p1 (nest-one p2 nested)))) + #:binding (nest p1 (nest p2 nested)))) (define-syntax define* (mylang-macro diff --git a/tests/binding-operations.rkt b/tests/binding-operations.rkt index 8e7855b..d5d73bd 100644 --- a/tests/binding-operations.rkt +++ b/tests/binding-operations.rkt @@ -15,7 +15,7 @@ #:binding (scope (bind x) e) (letrec ([x:var e:expr] ...) body:expr) - #:binding (scope (bind x) e (scope body))) + #:binding (scope (bind x) ... e ... (scope body))) (host-interface/definition (define-var v:var) diff --git a/tests/dsls/baby-peg.rkt b/tests/dsls/baby-peg.rkt index e871954..4fa4500 100644 --- a/tests/dsls/baby-peg.rkt +++ b/tests/dsls/baby-peg.rkt @@ -39,7 +39,7 @@ (host-interface/definitions (define-pegs [name:nonterm p:peg] ...) - #:binding (export name) + #:binding [(export name) ...] #'(begin (define name (lambda (s) (compile-peg p s))) ...)) diff --git a/tests/dsls/cmdline/cmdline.rkt b/tests/dsls/cmdline/cmdline.rkt index f3b4434..fe97526 100644 --- a/tests/dsls/cmdline/cmdline.rkt +++ b/tests/dsls/cmdline/cmdline.rkt @@ -59,7 +59,7 @@ #:allow-extension flag-macro ((~literal begin) f:flag ...+) [names:flag-names arg:arg-spec ... desc:string e:racket-expr] - #:binding (scope (import arg) e)) + #:binding (scope (import arg) ... e)) (nonterminal/exporting arg-spec (~> name:id #'[name identity/p]) @@ -78,7 +78,7 @@ ([option-name:racket-var opt:option] ...) (arg:arg-spec ...) rest:maybe-arg-spec) - #:binding [(export option-name) (re-export arg) (re-export rest)] + #:binding [(export option-name) ... (re-export arg) ... (re-export rest)] #:lhs [#:with ([arg-name _] ...) (attribute arg) #:attr rest-name (syntax-parse (attribute rest) [[rest-name _] #'rest-name] [_ #f]) #'(option-name ... arg-name ... (~? rest-name))] diff --git a/tests/dsls/js/js.rkt b/tests/dsls/js/js.rkt index d7bde2d..4fac188 100644 --- a/tests/dsls/js/js.rkt +++ b/tests/dsls/js/js.rkt @@ -61,7 +61,7 @@ (set! x:js-var e:js-expr) (function (x:js-var ...) body:js-stmt ...) - #:binding (scope (bind x) (scope (import body))) + #:binding (scope (bind x) ... (scope (import body ...))) (e:js-expr e*:js-expr ...)) @@ -80,11 +80,11 @@ (return e:js-expr) (while c:js-expr body:js-stmt ...) - #:binding (scope (import body)) + #:binding (scope (import body ...)) (if c:js-expr (b1:js-stmt ...) (b2:js-stmt ...)) - #:binding [(scope (import b1)) (scope (import b2))] - + #:binding [(scope (import b1 ...)) (scope (import b2 ...))] + e:js-expr)) diff --git a/tests/dsls/miniclass/class.rkt b/tests/dsls/miniclass/class.rkt index 2354e0c..c46b636 100644 --- a/tests/dsls/miniclass/class.rkt +++ b/tests/dsls/miniclass/class.rkt @@ -41,7 +41,7 @@ (nonterminal/exporting class-form #:allow-extension racket-macro (field name:field-var ...) - #:binding (export name) + #:binding [(export name) ...] ((~literal define-values) (m:method-var) (lambda:lambda-id (arg:id ...) body:racket-expr ...)) #:binding (export m) @@ -49,13 +49,13 @@ #:binding (export-syntaxes x e) ((~literal begin) e:class-form ...) - #:binding (re-export e) + #:binding [(re-export e) ...] e:racket-expr) (host-interface/expression (class e:class-form ...) - #:binding (scope (import e)) + #:binding (scope (import e ...)) (define-values (defns fields exprs) (group-class-decls (splice-begins (attribute e)))) (compile-class-body defns fields exprs))) diff --git a/tests/dsls/minikanren-binding-space-compile.rkt b/tests/dsls/minikanren-binding-space-compile.rkt index bdebe56..8d2426c 100644 --- a/tests/dsls/minikanren-binding-space-compile.rkt +++ b/tests/dsls/minikanren-binding-space-compile.rkt @@ -31,7 +31,7 @@ (host-interface/expression (run n:expr (qvar:term-variable ...) g:goal) - #:binding (scope (bind qvar) g) + #:binding (scope (bind qvar) ... g) #`(let ([qvar (gensym)] ...) #,(compile-goal #'g)))) diff --git a/tests/dsls/minikanren-binding-space.rkt b/tests/dsls/minikanren-binding-space.rkt index a0ffb6c..8d9f714 100644 --- a/tests/dsls/minikanren-binding-space.rkt +++ b/tests/dsls/minikanren-binding-space.rkt @@ -57,7 +57,7 @@ (conj2 g1:goal g2:goal) (fresh1 (x:term-variable ...) b:goal) - #:binding (scope (bind x) b) + #:binding (scope (bind x) ... b) (#%rel-app r:relation-name t:term ...+) diff --git a/tests/dsls/minikanren-compile-defs.rkt b/tests/dsls/minikanren-compile-defs.rkt index 04ac2de..33f092a 100644 --- a/tests/dsls/minikanren-compile-defs.rkt +++ b/tests/dsls/minikanren-compile-defs.rkt @@ -29,7 +29,7 @@ (host-interface/expression (run n:expr (qvar:term-variable ...) g:goal ...) - #:binding (scope (bind qvar) g) + #:binding (scope (bind qvar) ... g ...) #'(void)) @@ -40,18 +40,18 @@ (host-interface/definitions (define-relation (name:relation-name arg:term-variable ...) body:goal) - #:binding [(export name) (scope (bind arg) body)] + #:binding [(export name) (scope (bind arg) ... body)] #'(define tmp 5))) (syntax-spec (nonterminal/exporting mk-def (define-relation2 (name:relation-name arg:term-variable ...) body:goal) - #:binding [(export name) (scope (bind arg) body)]) + #:binding [(export name) (scope (bind arg) ... body)]) (host-interface/definitions (mk-defs d:mk-def ...) - #:binding (re-export d) + #:binding [(re-export d) ...] #'(define tmp 5))) diff --git a/tests/dsls/minikanren-compile.rkt b/tests/dsls/minikanren-compile.rkt index baef7d0..3c5cc0c 100644 --- a/tests/dsls/minikanren-compile.rkt +++ b/tests/dsls/minikanren-compile.rkt @@ -27,7 +27,7 @@ (host-interface/expression (run n:expr (qvar:term-variable ...) g:goal ...) - #:binding (scope (bind qvar) g) + #:binding (scope (bind qvar) ... g ...) #'(void)) diff --git a/tests/dsls/minikanren-rs2e/mk.rkt b/tests/dsls/minikanren-rs2e/mk.rkt index 70290de..a1823cc 100644 --- a/tests/dsls/minikanren-rs2e/mk.rkt +++ b/tests/dsls/minikanren-rs2e/mk.rkt @@ -59,6 +59,7 @@ #:binding (scope (bind x) b) (project (x:term-variable ...) e:racket-expr ...) + #:binding [x ...] (ifte g1:goal g2:goal g3:goal) (once g:goal) @@ -128,7 +129,7 @@ (syntax-spec (host-interface/definition (core-defrel (name:relation-name x:term-variable ...) g:goal) - #:binding [(export name) (scope (bind x) g)] + #:binding [(export name) (scope (bind x) ... g)] #:lhs [(symbol-table-set! @@ -150,7 +151,7 @@ #`(let ([q (var 'q)]) (map (reify q) (run-goal n (compile-goal g))))) - + (host-interface/expression (goal-expression g:goal) #`(goal-value (compile-goal g)))) diff --git a/tests/dsls/peg.rkt b/tests/dsls/peg.rkt index f1ce2dd..6f08338 100644 --- a/tests/dsls/peg.rkt +++ b/tests/dsls/peg.rkt @@ -18,7 +18,7 @@ (list e:expr ...)) (nonterminal peg-top - n:peg #:binding (nest-one n [])) + n:peg #:binding (nest n [])) (nonterminal/nesting peg (tail) #:description "PEG expression" @@ -28,29 +28,29 @@ (eps) ; can't just be `eps` yet. (seq e1:peg e2:peg) - #:binding (nest-one e1 (nest-one e2 tail)) + #:binding (nest e1 (nest e2 tail)) (alt e1:peg e2:peg) - #:binding [(nest-one e1 []) (nest-one e2 [])] + #:binding [(nest e1 []) (nest e2 [])] (repeat e:peg) ; * - #:binding (nest-one e []) + #:binding (nest e []) (not e:peg) ; ! - #:binding (nest-one e []) + #:binding (nest e []) (bind x:var e:peg) ; : - #:binding (scope (bind x) (nest-one e []) tail) + #:binding (scope (bind x) (nest e []) tail) (=> pe:peg e:expr) - #:binding (nest-one pe e) + #:binding (nest pe e) (text e:expr) ; right now these are referring to the expr syntax class. Need escape to Racket... (char e:expr) (token e:expr) (src-span v:var e:peg) - #:binding (scope (nest-one e [])) + #:binding (scope (nest e [])) ;; can't do implicit #%peg-datum yet. diff --git a/tests/dsls/peg/core.rkt b/tests/dsls/peg/core.rkt index ffcd38c..fdc77f0 100644 --- a/tests/dsls/peg/core.rkt +++ b/tests/dsls/peg/core.rkt @@ -69,7 +69,7 @@ (text e:text-expr) (=> ps:peg-seq e:racket-expr) - #:binding (nest-one ps e) + #:binding (nest ps e) (~> n:id #'(#%nonterm-ref n)) (#%nonterm-ref n:nonterm)) @@ -85,34 +85,34 @@ (~> p:ref-id #'(bind p.var p.ref)) (bind v:var ps:peg-seq) - #:binding (nest-one ps (scope (bind v) tail)) + #:binding (nest ps (scope (bind v) tail)) (seq ps1:peg-seq ps2:peg-seq) - #:binding (nest-one ps1 (nest-one ps2 tail)) + #:binding (nest ps1 (nest ps2 tail)) (alt e1:peg e2:peg) (? e:peg-seq) - #:binding (nest-one e tail) + #:binding (nest e tail) (plain-alt e1:peg-seq e2:peg-seq) - #:binding (nest-one e1 (nest-one e2 tail)) + #:binding (nest e1 (nest e2 tail)) (* ps:peg-seq) - #:binding (nest-one ps tail) + #:binding (nest ps tail) (src-span v:var ps:peg-seq) - #:binding (scope (bind v) (nest-one ps tail)) + #:binding (scope (bind v) (nest ps tail)) pe:peg-el) (nonterminal peg ps:peg-seq - #:binding (nest-one ps [])) + #:binding (nest ps [])) (host-interface/definitions (define-pegs [name:nonterm p:peg] ...) - #:binding (export name) + #:binding [(export name) ...] (run-leftrec-check! (attribute name) (attribute p)) #'(begin (define name (lambda (in) (with-reference-compilers ([var immutable-reference-compiler]) (compile-peg p in)))) diff --git a/tests/dsls/peg2.rkt b/tests/dsls/peg2.rkt index 35147f0..03010ef 100644 --- a/tests/dsls/peg2.rkt +++ b/tests/dsls/peg2.rkt @@ -21,29 +21,29 @@ (text e:racket-expr) (=> ps:peg-seq e:racket-expr) - #:binding (nest-one ps e)) + #:binding (nest ps e)) (nonterminal/nesting peg-seq (tail) #:description "PEG expression" #:allow-extension peg-macro (bind v:var ps:peg-seq) - #:binding (scope (bind v) (nest-one ps tail)) + #:binding (scope (bind v) (nest ps tail)) (seq ps1:peg-seq ps2:peg-seq) - #:binding (nest-one ps1 (nest-one ps2 tail)) + #:binding (nest ps1 (nest ps2 tail)) (repeat ps:peg-seq) - #:binding (nest-one ps tail) + #:binding (nest ps tail) (src-span v:var ps:peg-seq) - #:binding (scope (bind v) (nest-one ps tail)) + #:binding (scope (bind v) (nest ps tail)) pe:peg-el) (nonterminal peg ps:peg-seq - #:binding (nest-one ps []))) + #:binding (nest ps []))) (require racket/match) diff --git a/tests/dsls/qi-core.rkt b/tests/dsls/qi-core.rkt index bde4059..ec2266a 100644 --- a/tests/dsls/qi-core.rkt +++ b/tests/dsls/qi-core.rkt @@ -8,7 +8,7 @@ #:binding (scope (bind v) nested) (thread f:binding-floe ...) - #:binding (nest f nested) + #:binding (nest f ... nested) f:simple-floe #:binding [f nested]) @@ -20,7 +20,7 @@ (nonterminal floe f:binding-floe - #:binding (nest-one f []))) + #:binding (nest f []))) (void (expand-nonterminal/datum floe diff --git a/tests/dsls/simply-typed-lambda-calculus.rkt b/tests/dsls/simply-typed-lambda-calculus.rkt index f101ed6..9b1fb11 100644 --- a/tests/dsls/simply-typed-lambda-calculus.rkt +++ b/tests/dsls/simply-typed-lambda-calculus.rkt @@ -69,7 +69,7 @@ #'(compile-defn-or-expr/top (begin body ...))) (host-interface/definitions (stlc/module-begin body:typed-definition-or-expr ...+) - #:binding (re-export body) + #:binding [(re-export body) ...] (type-check-defn-or-expr/pass1 #'(begin body ...)) (type-check-defn-or-expr/pass2 #'(begin body ...)) (define/syntax-parse (name ...) (sequence->list (sequence-map compiled-from (in-symbol-set (definition-names #'(begin body ...)))))) diff --git a/tests/dsls/state-machine-oo/state-machine.rkt b/tests/dsls/state-machine-oo/state-machine.rkt index e2a0775..1b1c983 100644 --- a/tests/dsls/state-machine-oo/state-machine.rkt +++ b/tests/dsls/state-machine-oo/state-machine.rkt @@ -9,7 +9,7 @@ (host-interface/expression (machine #:initial-state s:state-name d:machine-decl ...) - #:binding (scope (import d) s) + #:binding (scope (import d ...) s) #'(compile-machine s d ...)) (nonterminal/exporting machine-decl @@ -23,4 +23,4 @@ (on (evt:id arg:racket-var ...) e:racket-expr ... ((~datum ->) s:state-name)) - #:binding (scope (bind arg) e))) \ No newline at end of file + #:binding (scope (bind arg) ... e ...))) diff --git a/tests/dsls/statecharts/statecharts.rkt b/tests/dsls/statecharts/statecharts.rkt index 5fa12a1..a7bd493 100644 --- a/tests/dsls/statecharts/statecharts.rkt +++ b/tests/dsls/statecharts/statecharts.rkt @@ -14,24 +14,24 @@ (nonterminal machine-spec [#:initial initial-state:state-name s:machine-element-spec ...] - #:binding (scope (import s) initial-state)) + #:binding (scope (import s) ... initial-state)) (nonterminal/exporting machine-element-spec (data v:data-var e:expr) #:binding (export v) (state n:state-name #:nested-machine nm:machine-name e:event-spec ...) - #:binding [(export n) nm e] + #:binding [(export n) nm e ...] (state n:state-name e:event-spec ...) - #:binding [(export n) e]) + #:binding [(export n) e ...]) (nonterminal event-spec (on (evt:id arg:local-var ...) #:when guard:racket-expr b:action-spec ... t:transition-spec) - #:binding (scope (bind arg) guard b) + #:binding (scope (bind arg) ... guard b ...) (on (evt:id arg:local-var ...) b:action-spec ... t:transition-spec) - #:binding (scope (bind arg) b)) + #:binding (scope (bind arg) ... b ...)) (nonterminal/nesting binding (nested) [v:local-var e:racket-expr] @@ -39,7 +39,7 @@ (nonterminal action-spec ((~literal let*) (b:binding ...) a:action-spec ...) - #:binding (nest b a) + #:binding (nest b ... [a ...]) (set v:data-var e:racket-expr) @@ -445,4 +445,4 @@ )) (test-turnstile turnstile)) - ) \ No newline at end of file + ) diff --git a/tests/dsls/stlc-on-typed-racket.rkt b/tests/dsls/stlc-on-typed-racket.rkt index 0f7a91d..824c52d 100644 --- a/tests/dsls/stlc-on-typed-racket.rkt +++ b/tests/dsls/stlc-on-typed-racket.rkt @@ -19,7 +19,7 @@ #'(compile-expr/top e)) (host-interface/definitions (stlc body:typed-definition-or-expr ...+) - #:binding (re-export body) + #:binding [(re-export body) ...] (type-check-defn-or-expr/pass1 #'(begin body ...)) (type-check-defn-or-expr/pass2 #'(begin body ...)) #'(compile-defn-or-expr (begin body ...)))) diff --git a/tests/dsls/tiny-hdl/hdl.rkt b/tests/dsls/tiny-hdl/hdl.rkt index ea79467..77ee855 100644 --- a/tests/dsls/tiny-hdl/hdl.rkt +++ b/tests/dsls/tiny-hdl/hdl.rkt @@ -23,7 +23,7 @@ #:binding (export name) (architecture name:arch-name e:entity-name stmt:statement ...) - #:binding [(export name) (scope (import stmt))]) + #:binding [(export name) (scope (import stmt) ...)]) (nonterminal port-spec (m:mode name:id)) @@ -57,7 +57,7 @@ (host-interface/definitions (begin-tiny-hdl t:top-item ...) - #:binding (re-export t) + #:binding [(re-export t) ...] (for ([t (attribute t)]) (register-entities! t)) @@ -172,4 +172,4 @@ (compile-port-set! entity in-port inst e) ... (displayln (list (compile-port-ref entity in-port inst) ... '-> (compile-port-ref entity out-port inst) ...))) - ...))) \ No newline at end of file + ...))) diff --git a/tests/dsls/typed-peg/core.rkt b/tests/dsls/typed-peg/core.rkt index 51968a1..a83e2ab 100644 --- a/tests/dsls/typed-peg/core.rkt +++ b/tests/dsls/typed-peg/core.rkt @@ -66,7 +66,7 @@ (text e:text-expr) (=> ps:peg-seq e:racket-expr) - #:binding (nest-one ps e) + #:binding (nest ps e) (~> n:id #'(#%nonterm-ref n)) (#%nonterm-ref n:nonterm)) @@ -82,34 +82,34 @@ (~> p:ref-id #'(bind p.var p.ref)) (bind v:var ps:peg-seq) - #:binding (nest-one ps (scope (bind v) tail)) + #:binding (nest ps (scope (bind v) tail)) (seq ps1:peg-seq ps2:peg-seq) - #:binding (nest-one ps1 (nest-one ps2 tail)) + #:binding (nest ps1 (nest ps2 tail)) (alt e1:peg e2:peg) (? e:peg-seq) - #:binding (nest-one e tail) + #:binding (nest e tail) (plain-alt e1:peg-seq e2:peg-seq) - #:binding (nest-one e1 (nest-one e2 tail)) + #:binding (nest e1 (nest e2 tail)) (* ps:peg-seq) - #:binding (nest-one ps tail) + #:binding (nest ps tail) (src-span v:var ps:peg-seq) - #:binding (scope (bind v) (nest-one ps tail)) + #:binding (scope (bind v) (nest ps tail)) pe:peg-el) (nonterminal peg ps:peg-seq - #:binding (nest-one ps [])) + #:binding (nest ps [])) (host-interface/definitions (define-pegs [name:nonterm p:peg] ...) - #:binding (export name) + #:binding [(export name) ...] #'(begin (define name (lambda ([in : text-rep]) (with-reference-compilers ([var immutable-reference-compiler]) (compile-peg p in)))) ...)) diff --git a/tests/errors.rkt b/tests/errors.rkt index 8496d42..6bd6d8d 100644 --- a/tests/errors.rkt +++ b/tests/errors.rkt @@ -81,7 +81,7 @@ #:binding (nest e [])))) (check-decl-error - #rx"nest: expected more terms starting with binding spec term" + #rx"nest: expected more terms" (syntax-spec (nonterminal expr b:expr @@ -154,8 +154,8 @@ (nonterminal/exporting decl ()) (nonterminal expr - (m (d:decl (... ...)) (... ...)) - #:binding (import d (... ...) (... ...))))) + (m (d:decl ...) ...) + #:binding (import d ... ...)))) (check-decl-error #rx"import cannot contain more than one ellipsis" @@ -163,9 +163,9 @@ (nonterminal/exporting decl ()) (nonterminal expr - (m (d:decl (... ...)) (... ...)) + (m (d:decl ...) ...) ; this one tests that we get the error even on [(import ...) ...] ~> (import ... ...) - #:binding [(import d (... ...)) (... ...)]))) + #:binding [(import d ...) ...]))) (check-decl-error #rx"exports must appear first in a exporting spec" @@ -206,6 +206,20 @@ (baz) (~>/form (foo #:bar) #'(foo))))) +(check-decl-error + #rx"nonterminal: missing ellipses with pattern variable in binding spec" + (syntax-spec + (nonterminal expr + (foo a:racket-var ...) + #:binding a))) + +(check-decl-error + #rx"nonterminal: too many ellipses for pattern variable in binding spec" + (syntax-spec + (nonterminal expr + (foo a:racket-var) + #:binding [a ...]))) + ;; ;; Valid definitions used to exercise errors ;; @@ -220,8 +234,11 @@ n:number v:dsl-var2 (dsl-begin e:expr1 ...+) + ; for testing incompatible ellipsis match counts + (dsl-groups (a:dsl-var2 ...+) (b:dsl-var2 ...+)) + #:binding [(scope (bind a) (bind b)) ...] [b:dsl-var2 e:expr1 ...+] - #:binding (scope (bind b) e)) + #:binding (scope (bind b) e ...)) (nonterminal expr2 #:description "DSL expression" n:number) @@ -426,3 +443,8 @@ (check-syntax-error #rx"foo: identifier's binding is ambiguous" (expand-nonterminal/datum expr3 (foo)))) + +; incompatible ellipsis match counts +(check-syntax-error + #rx"incompatible ellipsis match counts for binding spec" + (dsl-expr1 (dsl-groups (x y z) (a b c d)))) diff --git a/tests/nest-use-site-scope.rkt b/tests/nest-use-site-scope.rkt index 665753f..89ef3a1 100644 --- a/tests/nest-use-site-scope.rkt +++ b/tests/nest-use-site-scope.rkt @@ -17,7 +17,7 @@ (host-interface/expression (my-match [p:pat e:dsl-expr]) - #:binding (nest-one p e) + #:binding (nest p e) #''success)) ;; I'm not sure why, but the problem didn't occur at the module level. Perhaps @@ -31,13 +31,13 @@ (syntax-spec (nonterminal my-expr (block d:my-def ...) - #:binding (scope (import d))) + #:binding (scope (import d ...))) (nonterminal/exporting my-def ((~literal define-syntax) x:pat-macro e:expr) #:binding (export-syntax x e) ((~literal my-match) [p:pat e:dsl-expr]) - #:binding (nest-one p e)) + #:binding (nest p e)) (host-interface/expression (eval-my-expr e:my-expr) diff --git a/tests/nested-with-reference-compilers.rkt b/tests/nested-with-reference-compilers.rkt index ca964e3..b4022aa 100644 --- a/tests/nested-with-reference-compilers.rkt +++ b/tests/nested-with-reference-compilers.rkt @@ -11,7 +11,7 @@ (binding-class blue-var) (nonterminal blue-expr ((~literal let) ([x:blue-var e:racket-expr] ...) b:racket-expr) - #:binding (scope (bind x) b)) + #:binding (scope (bind x) ... b)) (host-interface/expression (blue e:blue-expr) @@ -23,7 +23,7 @@ (binding-class red-var) (nonterminal red-expr ((~literal let) ([x:red-var e:racket-expr] ...) b:racket-expr) - #:binding (scope (bind x) b)) + #:binding (scope (bind x) ... b)) (host-interface/expression (red e:red-expr) diff --git a/tests/symbol-collections.rkt b/tests/symbol-collections.rkt index 4ab1337..2a37aa3 100644 --- a/tests/symbol-collections.rkt +++ b/tests/symbol-collections.rkt @@ -51,14 +51,14 @@ (syntax-spec (nonterminal/exporting bind-expr (bind x:my-var ...) - #:binding (export x)) + #:binding [(export x) ...]) (nonterminal set-op-expr (intersection (x:my-var ...) (y:my-var ...)) (union (x:my-var ...) (y:my-var ...)) (subtract (x:my-var ...) (y:my-var ...))) (host-interface/definitions (my-define x:my-var ...) - #:binding (export x) + #:binding [(export x) ...] #'(begin (define x 1) ...)) (host-interface/expression (set-op e:set-op-expr) From 87e926b6f5ca2b16d841dc7c5df0c30da7ae043d Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Tue, 17 Sep 2024 18:41:44 -0400 Subject: [PATCH 08/25] inner ellipses for bind-syntaxes and export-syntaxes --- private/syntax/compile/binding-spec.rkt | 31 +++++++++---------------- tests/basic-langs/bind-syntax.rkt | 6 ++--- tests/basic-langs/block.rkt | 2 +- tests/dsls/miniclass/class.rkt | 2 +- 4 files changed, 16 insertions(+), 25 deletions(-) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index 75bc05d..7e36475 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -139,13 +139,10 @@ (elaborate-pvar (attribute v-transformer) (? stxclass-rep?) "syntax class"))] - [(bind-syntaxes ~! v:nonref-id v-transformer:nonref-id) - #;(bind-syntaxes ~! v:nonref-id (~and ooo (~literal ...)) ... v-transformer:nonref-id) - ; TODO update syntax + [(bind-syntaxes ~! v:nonref-id (~and ooo (~literal ...)) ... v-transformer:nonref-id) (bind-syntaxes this-syntax - 1 - #;(length (attribute ooo)) + (length (attribute ooo)) (elaborate-pvar (attribute v) (s* extclass-rep) "extension class") @@ -157,11 +154,11 @@ (when (> depth 1) (wrong-syntax/orig this-syntax "import cannot contain more than one ellipsis")) (rec - this-syntax - (length (attribute ooo)) - (elaborate-pvar (attribute v) - (s* nonterm-rep [variant-info (s* exporting-nonterm-info)]) - "exporting nonterminal"))] + this-syntax + (length (attribute ooo)) + (elaborate-pvar (attribute v) + (s* nonterm-rep [variant-info (s* exporting-nonterm-info)]) + "exporting nonterminal"))] [(re-export ~! v:nonref-id) (re-export this-syntax @@ -183,30 +180,24 @@ (elaborate-pvar (attribute v-transformer) (? stxclass-rep?) "syntax class"))] - [(export-syntaxes ~! v:nonref-id v-transformer:nonref-id) - #;(export-syntaxes ~! v:nonref-id (~and ooo (~literal ...)) ... v-transformer:nonref-id) - ; TODO update syntax + [(export-syntaxes ~! v:nonref-id (~and ooo (~literal ...)) ... v-transformer:nonref-id) (export-syntaxes this-syntax - 1 - #;(length (attribute ooo)) + (length (attribute ooo)) (elaborate-pvar (attribute v) (s* extclass-rep) "extension class") (elaborate-pvar (attribute v-transformer) (? stxclass-rep?) "syntax class"))] - [#;(nest-one ~! v:nonref-id spec:bspec-term) - (nest v:nonref-id spec:bspec-term) - ; TODO update syntax after old examples work + [(nest v:nonref-id spec:bspec-term) (nest-one this-syntax (elaborate-pvar (attribute v) (s* nonterm-rep [variant-info (s* nesting-nonterm-info)]) "nesting nonterminal") (elaborate-bspec (attribute spec)))] - [#;(nest ~! v:nonref-id spec:bspec-term) - (nest ~! v:nonref-id (~and (~literal ...) ooo) ...+ spec:bspec-term) + [(nest ~! v:nonref-id (~and (~literal ...) ooo) ...+ spec:bspec-term) (nest this-syntax (length (attribute ooo)) diff --git a/tests/basic-langs/bind-syntax.rkt b/tests/basic-langs/bind-syntax.rkt index c4a48f0..9bc4847 100644 --- a/tests/basic-langs/bind-syntax.rkt +++ b/tests/basic-langs/bind-syntax.rkt @@ -20,7 +20,7 @@ #:binding (scope (bind-syntax v e) ... b) (racket-letrec-syntaxes ([(v:racket-macro ...) e:expr] ...) b:racket-like-expr) - #:binding (scope (bind-syntaxes v e) ... b) + #:binding (scope (bind-syntaxes v ... e) ... b) e:racket-expr) (host-interface/expression @@ -56,7 +56,7 @@ #:binding (scope (bind-syntax v e) ... b) (my-letrec-syntaxes ([(v:my-macro ...) e:expr] ...) b:my-expr) - #:binding (scope (bind-syntaxes v e) ... b) + #:binding (scope (bind-syntaxes v ... e) ... b) ; this binds racket-macros, which cannot be used in my-exprs ; uses of bound macros should error. @@ -64,7 +64,7 @@ #:binding (scope (bind-syntax v e) ... b) (bad-my-letrec-syntaxes ([(v:racket-macro ...) e:expr] ...) b:my-expr) - #:binding (scope (bind-syntaxes v e) ... b)) + #:binding (scope (bind-syntaxes v ... e) ... b)) (host-interface/expression (my-lang e:my-expr) diff --git a/tests/basic-langs/block.rkt b/tests/basic-langs/block.rkt index 2e534c1..85a2740 100644 --- a/tests/basic-langs/block.rkt +++ b/tests/basic-langs/block.rkt @@ -16,7 +16,7 @@ #:binding [(export x) ...] ((~literal define-syntaxes) (x:racket-macro ...) e:expr) - #:binding (export-syntaxes x e) + #:binding (export-syntaxes x ... e) e:racket-expr) diff --git a/tests/dsls/miniclass/class.rkt b/tests/dsls/miniclass/class.rkt index c46b636..7dd417b 100644 --- a/tests/dsls/miniclass/class.rkt +++ b/tests/dsls/miniclass/class.rkt @@ -46,7 +46,7 @@ #:binding (export m) ((~literal define-syntaxes) (x:racket-macro ...) e:expr) - #:binding (export-syntaxes x e) + #:binding (export-syntaxes x ... e) ((~literal begin) e:class-form ...) #:binding [(re-export e) ...] From 4eeb66123fb72cdeb9bfb8ccea0a2828fe8b973c Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Tue, 17 Sep 2024 20:27:35 -0400 Subject: [PATCH 09/25] update docs for ellipses --- scribblings/reference/specifying.scrbl | 86 ++++++++++++++--------- scribblings/tutorial/basic-tutorial.scrbl | 27 ++++--- scribblings/tutorial/stlc-tutorial.scrbl | 10 +-- 3 files changed, 73 insertions(+), 50 deletions(-) diff --git a/scribblings/reference/specifying.scrbl b/scribblings/reference/specifying.scrbl index 6390e99..5e49b46 100644 --- a/scribblings/reference/specifying.scrbl +++ b/scribblings/reference/specifying.scrbl @@ -98,8 +98,8 @@ Example: (nonterminal my-expr n:number x:my-var - (my-let ([x:my-var e:my-expr]) body:my-expr) - #:binding (scope (bind x) body))))) + (my-let ([x:my-var e:my-expr] ...) body:my-expr) + #:binding (scope (bind x) ... body))))) @let-example @@ -117,7 +117,7 @@ Example: n:number x:my-var (my-let* (b:binding-pair ...) body:my-expr) - #:binding (nest b body)) + #:binding (nest b ... body)) (nonterminal/nesting binding-pair (nested) [x:my-var e:my-expr] #:binding (scope (bind x) nested))) @@ -138,7 +138,7 @@ Example: #:binding (export x) (my-begin d:my-defn ...) - #:binding (re-export d)) + #:binding [(re-export d) ...]) (nonterminal my-expr n:number)) ] @@ -204,10 +204,10 @@ A form production defines a form with the specified name. You may want to use a #:allow-extension racket-macro ((~literal define-values) (x:racket-var ...) e:racket-expr) - #:binding (export x) + #:binding [(export x) ...] ((~literal define-syntaxes) (x:racket-macro ...) e:expr) - #:binding (export-syntaxes x e) + #:binding (export-syntaxes x ... e) e:racket-expr)) ] @@ -269,22 +269,29 @@ When a form production's form is used outside of the context of a syntax-spec DS @section{Binding specs} -@racketgrammar[#:literals (bind bind-syntax bind-syntaxes import re-export export export-syntax export-syntaxes nest nest-one) - binding-spec spec-variable-id - (bind spec-variable-id ...+) - (bind-syntax spec-variable-id spec-variable-id) - (bind-syntaxes spec-variable-id spec-variable-id) - (scope spec ...) - [spec ...] - (nest spec-variable-id binding-spec) - (nest-one spec-variable-id binding-spec) - (import spec-variable-id ...+) - (export spec-variable-id ...+) - (export-syntax spec-variable-id spec-variable-id) - (export-syntaxes spec-variable-id spec-variable-id) - (re-export spec-variable-id ...+)] - -@deftech{Binding specs} declare the binding rules of a DSL's forms. They allow us to control the scope of bound variables and to check that programs are well-bound before compilation. A binding spec is associated with a production and refers to spec variables from the production +@racketgrammar*[#:literals (bind bind-syntax bind-syntaxes import re-export export export-syntax export-syntaxes nest ...) + (binding-spec + spec-variable-id + (bind spec-variable-id) + (bind-syntax spec-variable-id spec-variable-id) + (bind-syntaxes spec-variable-id ooo ... spec-variable-id) + (scope spec-or-ooo ...) + [spec-or-ooo ...] + (nest spec-variable-id ooo ... binding-spec) + (import spec-variable-id) + (export spec-variable-id) + (export-syntax spec-variable-id spec-variable-id) + (export-syntaxes spec-variable-id ooo ... spec-variable-id) + (re-export spec-variable-id)) + (ooo + ...) + (spec-or-ooo + binding-spec + ooo)] + +@deftech{Binding specs} declare the binding rules of a DSL's forms. They allow us to control the scope of bound variables and to check that programs are well-bound before compilation. A binding spec is associated with a production and refers to spec variables from the production. + +Similar to syntax patterns and templates, syntax specs and binding specs have a notion of ellipsis depth. However, all spec references in binding specs must have the exact same ellipsis depth as their syntax spec counterparts. Ellipses in binding specs are used to declare the scoping structure of syntax that includes sequences. @itemlist[ @item{ @@ -295,6 +302,8 @@ When a form production's form is used outside of the context of a syntax-spec DS Example: @let-example + + Notice how there are ellipses after the @racket[(bind x)] since @racket[x] occurred inside of an ellipsized syntax spec. } @item{ @racket[(bind-syntax x e)] declares that the variable specified by @racket[x] is bound to the transformer specified by @racket[e]. @racket[bind-syntax] must be used inside of a @racket[scope], @racket[x] must be specified with a binding class in its syntax spec like @racket[x:my-var], and @racket[e] must be specified with an extension class in its syntax spec like @racket[e:my-macro]. @@ -323,9 +332,11 @@ When a form production's form is used outside of the context of a syntax-spec DS #:allow-extension my-macro n:number (my-let-syntaxes ([(x:my-var ...) trans:my-macro]) body:my-expr) - #:binding (scope (bind-syntaxes x trans) body))) + #:binding (scope (bind-syntaxes x ... trans) body))) ] Here, @racket[trans] should evaluate to multiple transformers using @racket[values]. + + Note that the ellipses for @racket[x] occur inside of the @racket[bind-syntaxes]. } @item{ @racket[scope] declares that bindings and sub-expressions in the sub-specs are in a particular scope. Local bindings binding specs like @racket[bind] must occur directly in a @racket[scope] binding spec. @@ -342,9 +353,11 @@ When a form production's form is used outside of the context of a syntax-spec DS #:binding [(scope (bind x) body) e] ] Which adds that @racket[e] is a sub-expression outside of the scope of the @racket[let]. All un-referenced syntax spec variables get implicitly added to a group with the provided binding spec, so the former example is equivalent to the latter. + + Ellipses can occur after a binding spec in a group. } @item{ - @racket[nest] is used with @tech{nesting nonterminals}. In particular, the first argument to nest must be a spec variable associated with a nesting nonterminal. The second argument is treated as the "base case" of the "fold". @racket[nest] should only be used when the first argument has ellipsis depth 1. + @racket[nest] is used with @tech{nesting nonterminals}. In particular, the first argument to nest must be a spec variable associated with a nesting nonterminal. The second argument is treated as the "base case" of the "fold". Example: @@ -353,9 +366,8 @@ When a form production's form is used outside of the context of a syntax-spec DS The @racket[nest] binding spec sort of folds over the binding pairs. In this example, it'll produce binding structure like @racketblock[[e1 (scope (bind x1) [e2 (scope (bind x2) [... [en (scope (bind xn) body)]])])]] -} -@item{ - @racket[nest-one] is similar to @racket[nest], except it is used when the first argument has ellipsis depth 0. + + @racket[nest] does not necessarily have to be used with a sequence. Example: @racketblock[ @@ -363,13 +375,15 @@ When a form production's form is used outside of the context of a syntax-spec DS (binding-class pattern-var) (nonterminal clause [p:pat e:racket-expr] - #:binding (nest-one p e)) + #:binding (nest p e)) (nonterminal/nesting pat (nested) x:pattern-var #:binding (scope (bind x) nested) ((~literal cons) car-pat:pat cdr-pat:pat) - #:binding (nest-one car-pat (nest-one cdr-pat nested)))) + #:binding (nest car-pat (nest cdr-pat nested)))) ] + + However, the first arguemnt of @racket[nest] cannot have ellipsis depth exceeding one. } @item{ @racket[(import d)] imports the bindings exported from the sub-expression specified by @racket[d]. @racket[import] must be used inside of a @racket[scope] and must refer to a syntax spec associated with an @tech{exporting nonterminal}. @@ -383,21 +397,23 @@ When a form production's form is used outside of the context of a syntax-spec DS #:binding (export x) (my-begin d:my-defn ...) - #:binding (re-export d)) + #:binding [(re-export d) ...]) (nonterminal my-expr n:number (my-local [d:my-defn ...] body:my-expr) - #:binding (scope (import d) body))) + #:binding (scope (import d) ... body))) ] + + The argument to @racket[import] cannot have ellipsis depth exceeding one. } @item{ @racket[(export x)] exports the variable specified by @racket[x]. @racket[x] must refer to a syntax spec variable associated with a binding class and @racket[export] can only be used in an @tech{exporting nonterminal}. See @racket[import] for an example of usage. } @item{ - @racket[(export-syntax x e)] is like @racket[bind-syntax], except it exports the binding instead of binding the identifier locally to the current scope. Like @racket[export], it can only be used in an @tech{exporting nonterminal}. + @racket[export-syntax] is like @racket[bind-syntax], except it exports the binding instead of binding the identifier locally to the current scope. Like @racket[export], it can only be used in an @tech{exporting nonterminal}. } @item{ - @racket[(export-syntaxes x e)] is like @racket[bind-syntaxes], except it exports the bindings instead of binding the identifiers locally to the current scope. Like @racket[export], it can only be used in an @tech{exporting nonterminal}. + @racket[export-syntaxes] is like @racket[bind-syntaxes], except it exports the bindings instead of binding the identifiers locally to the current scope. Like @racket[export], it can only be used in an @tech{exporting nonterminal}. } @item{ @racket[(re-export d)] @racket[export]s all bindings that are exported by @racket[d]. @racket[d] must be associated with an @tech{exporting nonterminal} and @racket[re-export] can only be used in an @tech{exporting nonterminal}. See @racket[import] for an example of usage. @@ -465,7 +481,7 @@ An example from the @hyperlink["https://github.com/michaelballantyne/syntax-spec (host-interface/definition (defrel (name:relation-name x:term-variable ...) g:goal) - #:binding [(export name) (scope (bind x) g)] + #:binding [(export name) (scope (bind x) ... g)] #:lhs [(symbol-table-set! @@ -501,7 +517,7 @@ An example from the @hyperlink["https://github.com/michaelballantyne/syntax-spec (syntax-spec (host-interface/definitions (define-pegs [name:nonterm p:peg] ...) - #:binding (export name) + #:binding [(export name) ...] (run-leftrec-check! (attribute name) (attribute p)) #'(begin (define name (lambda (in) (with-reference-compilers ([var immutable-reference-compiler]) (compile-peg p in)))) diff --git a/scribblings/tutorial/basic-tutorial.scrbl b/scribblings/tutorial/basic-tutorial.scrbl index 8f02173..b66ce57 100644 --- a/scribblings/tutorial/basic-tutorial.scrbl +++ b/scribblings/tutorial/basic-tutorial.scrbl @@ -154,8 +154,9 @@ First, let's declare that the arguments to an action are in scope in the guard e (on (event-name:id arg:event-var ...) action:action-spec ... - ((~datum goto) next-state:id))) - #:binding (scope (bind arg) body) + ((~datum goto) next-state:id)) + #:binding (scope (bind arg) ... action ...)) + (nonterminal action-spec ((~datum displayln) x:event-var)))) @@ -169,12 +170,16 @@ These simple binding rules behave like @racket[let]: (binding-class my-var) (nonterminal my-expr (my-let ([x:my-var e:my-expr] ...) body:my-expr) - #:binding [e (scope (bind x) body)] + #:binding [e ... (scope (bind x) ... body)] x:my-var n:number)) ] -We could've just written @racket[(scope (bind x) body)]. syntax-spec will automatically treat @racket[e] as a reference position outside of the new scope. That's why we don't have to mention @racket[event-name] in the binding rules for transitions. Additionally, for @racket[action-spec] expressions, there is an implicit @racket[#:binding] rule generated that treats @racket[x] as a reference position. +We could've just written @racket[(scope (bind x) ... body)]. syntax-spec will automatically treat @racket[e] as a reference position outside of the new scope. That's why we don't have to mention @racket[event-name] in the binding rules for transitions. Additionally, for @racket[action-spec] expressions, there is an implicit @racket[#:binding] rule generated that treats @racket[x] as a reference position. + +Notice that there are ellipses in the binding spec corresponding to the ellipses in the syntax spec. Like with syntax patterns and syntax templates, ellipses allow us to control the binding structure of syntax with sequences like @racket[[x:my-var e:my-expr] ...]. + +All spec references in a binding spec must have the same depth as their syntax spec counterparts. This is stricter than syntax templates, where it is possible for a template variable to occur with greater ellipsis depth than its associated pattern variable. @subsection{Separate scope and binding forms} @@ -186,7 +191,7 @@ Now let's add binding rules for state names. We can't just use @racket[scope] an @(racketblock (host-interface/expression (machine #:initial initial-state:state-name s:state-spec ...) - #:binding (scope (import s) initial-state) + #:binding (scope (import s) ... initial-state) (error 'machine "compiler not yet implemented")) (nonterminal/exporting state-spec @@ -215,7 +220,7 @@ There is another type of binding rule that doesn't fit into our state machine la (binding-class my-var) (nonterminal my-expr (my-let* (b:binding-pair ...) body:my-expr) - #:binding (nest b body) + #:binding (nest b ... body) n:number x:my-var) (nonterminal/nesting binding-pair (nested) @@ -228,6 +233,8 @@ The @deftech{scope tree} is a first-class representation of the binding structur From the simple nonterminal @racket[my-expr], we put the @racket[binding-pair]'s bindings in scope using @racket[nest], providing @racket[body] as the intial value of @racket[nested], like the base case value of @racket[foldr]. +Since we're folding over the sequence of @racket[b]s, the ellipses are inside of the @racket[nest]. + @section[#:tag "racket"]{Integrating Racket Subexpressions} In our state machine language, action expressions are very limited. Let's remind ourselves what the grammar for an action expression looks like: @@ -254,7 +261,7 @@ An action expression can only @racket[displayln] the value of a variable. What i body:racket-expr ... ((~datum goto) next-state-name:state-name)) - #:binding (scope (bind arg) body)) + #:binding (scope (bind arg) ... body)) ...)) @@ -271,7 +278,7 @@ Now that we have our grammar and binding rules defined, we must write a compiler ... (host-interface/expression (machine #:initial initial-state:state-name s:state-spec ...) - #:binding (scope (import s) initial-state) + #:binding (scope (import s) ... initial-state) (error 'machine "compiler not yet implemented")) ...) ] @@ -360,7 +367,7 @@ Now Let's start to write the compiler: ... (host-interface/expression (machine #:initial initial-state:state-name s:state-spec ...) - #:binding (scope (import s) initial-state) + #:binding (scope (import s) ... initial-state) #'(compile-machine initial-state s ...)) ...) @@ -475,7 +482,7 @@ In our language's compiler, we can use symbol set to raise an error when a state ... (host-interface/expression (machine #:initial initial-state:state-name s:state-spec ...) - #:binding (scope (import s) initial-state) + #:binding (scope (import s) ... initial-state) (check-for-inaccessible-states #'initial-state (attribute s)) #'(compile-machine initial-state s ...)) ...) diff --git a/scribblings/tutorial/stlc-tutorial.scrbl b/scribblings/tutorial/stlc-tutorial.scrbl index d0259b3..c23df1e 100644 --- a/scribblings/tutorial/stlc-tutorial.scrbl +++ b/scribblings/tutorial/stlc-tutorial.scrbl @@ -28,11 +28,11 @@ Let's start out with defining the grammar and binding rules for basic typed expr n:number (#%lambda ([x:typed-var (~datum :) t:type] ...) body:typed-expr) - #:binding (scope (bind x) body) + #:binding (scope (bind x) ... body) (#%app fun:typed-expr arg:typed-expr ...) (#%let ([x:typed-var e:typed-expr] ...) body:typed-expr) - #:binding (scope (bind x) body) + #:binding (scope (bind x) ... body) (~> (e (~datum :) t) #'(: e t)) @@ -362,7 +362,7 @@ Next, let's add definitions to our language: ... (block d:typed-definition-or-expr ... e:typed-expr) - #:binding (scope (import d) e) + #:binding (scope (import d) ... e) ...) @@ -374,14 +374,14 @@ Next, let's add definitions to our language: (#%define x:typed-var t:type e:typed-expr) #:binding (export x) (begin defn:typed-definition-or-expr ...+) - #:binding (re-export defn) + #:binding [(re-export defn) ...] e:typed-expr) ... (host-interface/definitions (stlc body:typed-definition-or-expr ...+) - #:binding (re-export body) + #:binding [(re-export body) ...] (type-check-defn-or-expr/pass1 #'(begin body ...)) (type-check-defn-or-expr/pass2 #'(begin body ...)) #'(compile-defn-or-expr/top (begin body ...)))) From 847ee8ae7a1b25c42f344752dda408307d8e1f6e Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Tue, 17 Sep 2024 20:31:50 -0400 Subject: [PATCH 10/25] static check for nest with > 1 ellipses fixes #31 --- private/syntax/compile/binding-spec.rkt | 5 ++++- tests/errors.rkt | 10 ++++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index 7e36475..3de429e 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -198,9 +198,12 @@ "nesting nonterminal") (elaborate-bspec (attribute spec)))] [(nest ~! v:nonref-id (~and (~literal ...) ooo) ...+ spec:bspec-term) + (define depth (length (attribute ooo))) + (when (> depth 1) + (wrong-syntax/orig this-syntax "nest cannot contain more than one ellipsis")) (nest this-syntax - (length (attribute ooo)) + depth (elaborate-pvar (attribute v) (s* nonterm-rep [variant-info (s* nesting-nonterm-info)]) "nesting nonterminal") diff --git a/tests/errors.rkt b/tests/errors.rkt index 6bd6d8d..9682df1 100644 --- a/tests/errors.rkt +++ b/tests/errors.rkt @@ -167,6 +167,16 @@ ; this one tests that we get the error even on [(import ...) ...] ~> (import ... ...) #:binding [(import d ...) ...]))) +(check-decl-error + #rx"nest cannot contain more than one ellipsis" + (syntax-spec + (nonterminal/nesting binding (nested) + ()) + (nonterminal expr + (m (b:binding ...) ...) + ; this one tests that we get the error even on [(import ...) ...] ~> (import ... ...) + #:binding (nest d ... ... [])))) + (check-decl-error #rx"exports must appear first in a exporting spec" (syntax-spec From b8f7009814b89e645e7bd7d02a8ac4d24c34322b Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sat, 21 Sep 2024 09:59:34 -0400 Subject: [PATCH 11/25] no depth in runtime nest --- private/runtime/binding-spec.rkt | 15 ++++----------- private/syntax/compile/binding-spec.rkt | 2 +- private/test/sequence.rkt | 2 +- 3 files changed, 6 insertions(+), 13 deletions(-) diff --git a/private/runtime/binding-spec.rkt b/private/runtime/binding-spec.rkt index 456c1be..e3d319d 100644 --- a/private/runtime/binding-spec.rkt +++ b/private/runtime/binding-spec.rkt @@ -64,7 +64,7 @@ (struct bind-syntaxes [depth pvar space bvalc transformer-pvar] #:transparent) (struct scope [spec] #:transparent) (struct group [specs] #:transparent) -(struct nest [depth pvar nonterm spec] #:transparent) +(struct nest [pvar nonterm spec] #:transparent) (struct nest-one [pvar nonterm spec] #:transparent) (struct nested [] #:transparent) (struct suspend [pvar] #:transparent) @@ -280,22 +280,15 @@ ([spec specs]) (simple-expand-internal spec st local-scopes))] - [(nest depth pv f inner-spec) - (when (> depth 1) - (error "don't know how to handle depth > 1 yet")) - - (define init-seq (if (= 0 depth) - (list (get-pvar st pv)) - (get-pvar st pv))) + [(nest pv f inner-spec) + (define init-seq (get-pvar st pv)) (define res (start-nest f init-seq st inner-spec local-scopes)) (match-define (nest-ret done-seq st^) res) - (set-pvar st^ pv (if (= 0 depth) - (car done-seq) - done-seq))] + (set-pvar st^ pv done-seq)] ; TODO deprecate [(nest-one pv f inner-spec) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index 3de429e..7cbae2a 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -625,7 +625,7 @@ (match info [(nonterm-rep (nesting-nonterm-info expander)) (with-syntax ([spec-c (compile-bspec-term/single-pass spec)]) - #`(nest #,depth '#,v #,expander spec-c))])] + #`(nest '#,v #,expander spec-c))])] [(nest-one _ (pvar v info) spec) (match info [(nonterm-rep (nesting-nonterm-info expander)) diff --git a/private/test/sequence.rkt b/private/test/sequence.rkt index 9773c49..18b9a1d 100644 --- a/private/test/sequence.rkt +++ b/private/test/sequence.rkt @@ -49,7 +49,7 @@ [(mylang-let* (b ...) e) ; #:binding (fold b e) (define bspec - (nest 1 'b mylang-expand-binding-group + (nest 'b mylang-expand-binding-group (subexp 'e mylang-expand-expr))) (expand-function-return From fa3570fe8ff7ec73bd021e337c24b79af1f30cd5 Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sat, 21 Sep 2024 10:01:28 -0400 Subject: [PATCH 12/25] comments --- private/runtime/binding-spec.rkt | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/private/runtime/binding-spec.rkt b/private/runtime/binding-spec.rkt index e3d319d..df8a27b 100644 --- a/private/runtime/binding-spec.rkt +++ b/private/runtime/binding-spec.rkt @@ -75,8 +75,10 @@ ;; Expansion ;; +; A NestState is one of +;; #f, nest-call, or nest-ret + ;; pvar-vals is (hashof symbol? (treeof syntax?)) -;; nest-state is #f, nest-call, or nest-ret (struct exp-state [pvar-vals nest-state]) ;; Helpers for accessing and updating parts of the exp-state @@ -85,7 +87,7 @@ (define (get-pvar st pv) (hash-ref (exp-state-pvar-vals st) pv)) -; exp-state? symbol? (treeof syntax?) -> (treeof syntax?) +; exp-state? symbol? (treeof syntax?) -> exp-state? (define (set-pvar st pv val) (struct-copy exp-state st @@ -107,7 +109,7 @@ exp-state st [pvar-vals env^])) -; exp-state? ((or/c #f nest-call? nest-ret?) -> (or/c #f nest-call? nest-ret?)) -> exp-state? +; exp-state? (NestState -> NestState) -> exp-state? (define (update-nest-state st f) (struct-copy exp-state st From e63266063b5f059797379429d7e34cb789b4010f Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sat, 21 Sep 2024 10:07:05 -0400 Subject: [PATCH 13/25] no depth in runtime bind-syntaxes --- private/runtime/binding-spec.rkt | 6 ++---- private/syntax/compile/binding-spec.rkt | 4 ++-- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/private/runtime/binding-spec.rkt b/private/runtime/binding-spec.rkt index df8a27b..f07b32b 100644 --- a/private/runtime/binding-spec.rkt +++ b/private/runtime/binding-spec.rkt @@ -61,7 +61,7 @@ (struct rename-bind [pvar space] #:transparent) (struct bind [pvar space bvalc] #:transparent) (struct bind-syntax [pvar space bvalc transformer-pvar] #:transparent) -(struct bind-syntaxes [depth pvar space bvalc transformer-pvar] #:transparent) +(struct bind-syntaxes [pvar space bvalc transformer-pvar] #:transparent) (struct scope [spec] #:transparent) (struct group [specs] #:transparent) (struct nest [pvar nonterm spec] #:transparent) @@ -233,9 +233,7 @@ (define scoped-transformer-stx (add-scopes transformer-stx local-scopes)) (let ([bound-id (bind-and-record-rename! (add-scopes id local-scopes) #`(#,constr-id #,(flip-intro-scope scoped-transformer-stx)) space)]) (values scoped-transformer-stx bound-id)))] - [(bind-syntaxes depth pv space constr-id transformer-pv) - (unless (= 1 depth) - (error "don't know how to handle depth > 1 yet")) + [(bind-syntaxes pv space constr-id transformer-pv) (for/pv-state-tree ([transformer-stx transformer-pv] [ids pv]) (when DEBUG-RENAME (displayln 'bind-syntaxes) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index 7cbae2a..e09742d 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -598,7 +598,7 @@ [(bind-syntax _ (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) #`(group (list (bind-syntax '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] [(bind-syntaxes _ depth (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) - #`(group (list (bind-syntaxes #,depth '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] + #`(group (list (bind-syntaxes '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] [(recs ss) (match ss [(list (rec _ _ pvs) ...) @@ -664,7 +664,7 @@ [(export-syntax _ (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) #`(group (list (bind-syntax '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] [(export-syntaxes _ depth (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) - #`(group (list (bind-syntaxes #,depth '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] + #`(group (list (bind-syntaxes '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] [(re-export _ pv) (match-define (pvar v (nonterm-rep (exporting-nonterm-info pass1-expander _))) pv) #`(subexp '#,v #,pass1-expander)] From 44712dbf7c4e19ed9ab478863e27dea449506487 Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sat, 21 Sep 2024 10:36:31 -0400 Subject: [PATCH 14/25] clearer ellipsis expansion --- private/runtime/binding-spec.rkt | 33 ++++++++++++++++++++++++++++---- 1 file changed, 29 insertions(+), 4 deletions(-) diff --git a/private/runtime/binding-spec.rkt b/private/runtime/binding-spec.rkt index f07b32b..bd837e5 100644 --- a/private/runtime/binding-spec.rkt +++ b/private/runtime/binding-spec.rkt @@ -317,10 +317,7 @@ (define sts^ (for/list ([st sts]) (simple-expand-internal spec st local-scopes))) - ; unsplit the sub-environments and merge that into the initial env. - (for/fold ([st st]) - ([pv pvs]) - (set-pvar st pv (for/list ([st^ sts^]) (hash-ref (exp-state-pvar-vals st^) pv))))])) + (st-merge/ellipses st pvs sts^)])) ; f is nonterm-transformer ; seq is (listof (treeof syntax?)) @@ -346,7 +343,23 @@ (call-reconstruct-function (exp-state-pvar-vals st^) reconstruct-f) (exp-state-nest-state st^))])) +; ellipsis expansion +; when expanding syntax with an ellipsized binding spec, we expect the syntax to be a list. +; For example: +; (e:my-expr ...) +; #:binding [e ...] +; #'(f x y z) +; We'll start with e mapped to (list #'f #'x #'y #'z) +; But since it's ellipsized, we want to run the expander for each element of that list. +; This means we need to expand under an environment mapping e to #'f, +; then expand under an environment mapping e to #'x, and so on. +; Then we'll have a list of environments, each mapping e to an expanded #'f, #'x, #'y, or #'z. +; Let's call those expanded syntaxes #'f^, #'x^, #'y^, #'z^ +; Finally, we need to merge those sub-environments back into the same shape as the original +; so we end up with e mapped to (list #'f^ #'x^ #'y^ #'z^). + ; exp-state? (listof symbol?) -> (listof exp-state?) +; split an environment mapping pvars to lists into a list of environments mapping pvars to list elements. (define (exp-state-split/ellipsis st pvars) (match st [(exp-state pvar-vals nest-state) @@ -396,6 +409,18 @@ (check-equal? (env-repetition-length (hash 'a '(1 2 3) 'b '(4 5 6))) 3)) +; exp-state? (listof symbol?) (listof exp-state?) -> exp-state? +; merge expanded sub-environments into the original environment. +; st is original state. +; sts^ is a list of states from sub-expansions of each ellipsis repetition. +; pvs is the pvars referenced in the ellipsized binding spec. +(define (st-merge/ellipses st pvs sts^) + ; can maintain st's nest state because nested will never occur inside ellipses, + ; so nest state will not have changed in any of the sub-expansions. + (for/fold ([st st]) + ([pv pvs]) + (set-pvar st pv (for/list ([st^ sts^]) (hash-ref (exp-state-pvar-vals st^) pv))))) + ;; When entering a `nest-one` or `nest` form, add an extra scope. This means that the ;; expansion within is in a new definition context with a scope distinguishing it from ;; surrounding definition contexts where macros may have been defined. The Racket expander From b5e5f1aefc68bcb86cd5bf7566f62a0ffaf60db1 Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Wed, 25 Sep 2024 17:23:32 -0400 Subject: [PATCH 15/25] rec ~> import, imports absorb ellipses --- demos/minimal-state-machine/state-machine.rkt | 2 +- demos/visser-symposium/state-machine.rkt | 2 +- private/syntax/compile/binding-spec.rkt | 119 ++++++++++-------- tests/basic-langs/block.rkt | 2 +- tests/basic-langs/define.rkt | 2 +- tests/dsls/js/js.rkt | 6 +- tests/dsls/miniclass/class.rkt | 2 +- tests/dsls/simply-typed-lambda-calculus.rkt | 2 +- tests/dsls/state-machine-for-tutorial.rkt | 2 +- tests/dsls/state-machine-oo/state-machine.rkt | 2 +- tests/errors.rkt | 19 --- tests/multi-import.rkt | 15 ++- tests/nest-use-site-scope.rkt | 2 +- 13 files changed, 91 insertions(+), 86 deletions(-) diff --git a/demos/minimal-state-machine/state-machine.rkt b/demos/minimal-state-machine/state-machine.rkt index 423c43c..5b98614 100644 --- a/demos/minimal-state-machine/state-machine.rkt +++ b/demos/minimal-state-machine/state-machine.rkt @@ -10,7 +10,7 @@ (host-interface/expression (machine #:initial-state s:state-name d:machine-decl ...) - #:binding (scope (import d ...) s) + #:binding (scope (import d) ... s) #'(compile-machine s d ...)) (nonterminal/exporting machine-decl diff --git a/demos/visser-symposium/state-machine.rkt b/demos/visser-symposium/state-machine.rkt index 5f6c609..83dea45 100644 --- a/demos/visser-symposium/state-machine.rkt +++ b/demos/visser-symposium/state-machine.rkt @@ -9,7 +9,7 @@ (host-interface/expression (machine #:initial-state s:state-name d:machine-decl ...) - #:binding (scope (import d ...) s) + #:binding (scope (import d) ... s) #'(compile-machine s d ...)) (nonterminal/exporting machine-decl diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index e09742d..80679fe 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -33,17 +33,20 @@ (check-ellipsis-depth bspec-elaborated) (define bspec-with-implicits (add-implicit-pvar-refs bspec-elaborated bound-pvars)) (define bspec-flattened (bspec-flatten-groups bspec-with-implicits)) - (define bspec-combined-recs (bspec-combine-recs bspec-flattened)) + ; might need to re-flatten after distributing + (define bspec-distributed-ellipses (bspec-flatten-groups (bspec-distribute-ellipses bspec-flattened))) + (define bspec-absorbed-ellipses (bspec-absorb-ellipses-into-imports bspec-distributed-ellipses)) + (define bspec-combined-imports (bspec-combine-imports bspec-absorbed-ellipses)) (syntax-parse variant [(~or #:simple (#:nesting _)) - (check-order/unscoped-expression bspec-combined-recs) - (compile-bspec-term/single-pass bspec-combined-recs)] + (check-order/unscoped-expression bspec-combined-imports) + (compile-bspec-term/single-pass bspec-combined-imports)] [#:pass1 - (check-order/exporting bspec-combined-recs) - (compile-bspec-term/pass1 bspec-combined-recs)] + (check-order/exporting bspec-combined-imports) + (compile-bspec-term/pass1 bspec-combined-imports)] [#:pass2 - #`(fresh-env-expr-ctx #,(compile-bspec-term/pass2 bspec-combined-recs))])) + #`(fresh-env-expr-ctx #,(compile-bspec-term/pass2 bspec-combined-imports))])) ;; Elaborated representation; variables are associated with expander-environment information @@ -56,10 +59,10 @@ (struct bind with-stx [pvar] #:transparent) (struct bind-syntax with-stx [pvar transformer-pvar] #:transparent) (struct bind-syntaxes with-stx [depth pvar transformer-pvar] #:transparent) -(struct rec with-stx [depth pvar] #:transparent) -; no surface syntax, just a mechanism to combine recs -; something like [(import x) (import y)] ~> (recs (list (rec x) (rec y))) -(struct recs [specs] #:transparent) +(struct import with-stx [pvar] #:transparent) +; no surface syntax, just a mechanism to combine imports +; something like [(import x) (import y)] ~> (imports (list (import x) (import y))) +(struct imports [specs] #:transparent) (struct re-export with-stx [pvar] #:transparent) (struct export with-stx [pvar] #:transparent) (struct export-syntax with-stx [pvar transformer-pvar] #:transparent) @@ -92,9 +95,9 @@ [(group ss) (let ([ss^ (map (lambda (s) (map-bspec f s)) ss)]) (f (group ss^)))] - [(recs ss) + [(imports ss) (let ([ss^ (map (lambda (s) (map-bspec f s)) ss)]) - (f (recs ss^)))] + (f (imports ss^)))] [(ellipsis stx s) (f (ellipsis stx (map-bspec f s)))] [_ (f spec)])) @@ -109,7 +112,7 @@ (s* ellipsis [spec s])) (let ([s^ (fold-bspec f s)]) (f spec (list s^)))] - [(or (recs ss) (group ss)) + [(or (imports ss) (group ss)) (let ([ss^ (map (lambda (s) (fold-bspec f s)) ss)]) (f spec ss^))] [_ (f spec '())])) @@ -149,13 +152,9 @@ (elaborate-pvar (attribute v-transformer) (? stxclass-rep?) "syntax class"))] - [(import ~! v:nonref-id (~and ooo (~literal ...)) ...) - (define depth (length (attribute ooo))) - (when (> depth 1) - (wrong-syntax/orig this-syntax "import cannot contain more than one ellipsis")) - (rec + [(import ~! v:nonref-id) + (import this-syntax - (length (attribute ooo)) (elaborate-pvar (attribute v) (s* nonterm-rep [variant-info (s* exporting-nonterm-info)]) "exporting nonterminal"))] @@ -224,10 +223,6 @@ (define elaborate-group (syntax-parser #:datum-literals (import) - [((import v:id (~and ooo/inside (~literal ...)) ...) (~and ooo/outside (~literal ...)) ... . specs) - ; move ellipses outside of import into the import - (cons (elaborate-bspec #'(import v ooo/inside ... ooo/outside ...)) - (elaborate-group (attribute specs)))] [(spec (~and ooo (~literal ...)) ... . specs) ; however many ellipses follow the pattern, wrap the elaborated spec with ; the ellipses struct that many times. @@ -305,9 +300,9 @@ (bind-syntaxes stx v-depth (pvar v _) (pvar tv _))) (check-ellipsis-depth/pvar (+ v-depth depth) v stx) (check-ellipsis-depth/pvar depth tv stx)] - [(rec stx rec-depth (pvar v _)) - (check-ellipsis-depth/pvar (+ rec-depth depth) v stx)] - [(or (group ss) (recs ss)) + [(import stx (pvar v _)) + (check-ellipsis-depth/pvar depth v stx)] + [(or (group ss) (imports ss)) (for ([s ss]) (loop s depth))] [(nest stx nest-depth (pvar v _) s) @@ -352,7 +347,7 @@ (s* nest [pvar (pvar v _)]) (s* nest-one [pvar (pvar v _)]) (s* suspend [pvar (pvar v _)]) - (s* rec [pvar (pvar v _)]) + (s* import [pvar (pvar v _)]) (s* re-export [pvar (pvar v _)])) (list v)] [(or (s* bind-syntax [pvar (pvar v1 _)] [transformer-pvar (pvar v2 _)]) @@ -370,6 +365,7 @@ (map-bspec (lambda (spec) (match spec + [(group (list spec)) spec] [(group l) (group (append* (map flat-bspec-top-elements l)))] [_ spec])) bspec)) @@ -379,16 +375,39 @@ [(group l) l] [_ (list el)])) -; combine consecutive recs in a group -(define (bspec-combine-recs bspec) +; convert ([a b c] ...) to [a ... b ... c ...] +(define (bspec-distribute-ellipses bspec) + (map-bspec + (lambda (spec) + (match spec + [(ellipsis stx (group specs)) + (group (for/list ([spec specs]) (ellipsis stx spec)))] + [_ spec])) + bspec)) + +; convert ((import x) ...) to (import x) +; only do this after checking ellipses since it erases them +(define (bspec-absorb-ellipses-into-imports bspec) + (map-bspec + (lambda (spec) + (match spec + [(ellipsis _ (import stx pv)) + (import stx pv)] + [_ spec])) + bspec)) + +; combine consecutive imports in a group +(define (bspec-combine-imports bspec) (map-bspec (lambda (spec) (match spec + [(scope stx (and imp (s* import))) + (scope stx (imports (list imp)))] [(group l) (group (let loop ([l l]) (match l - [(list (and rs (s* rec)) ..1 ss ...) - (cons (recs rs) (loop ss))] + [(list (and imps (s* import)) ..1 ss ...) + (cons (imports imps) (loop ss))] [(cons s ss) (cons s (loop ss))] [(list) (list)])))] @@ -405,9 +424,9 @@ ; - (scope (nest a [(bind x) x)])) shouldn't be legal as it would imply binding ; in a scope created by the nesting non-terminal, and the binding might ; come after a reference created in the nesting non-terminal. -; - Bindings should come before rec and references within a scope +; - Bindings should come before import and references within a scope ; - Exports may only occur at the top-level of a exporting non-terminal, -; and appear before rec and references +; and appear before import and references ; - Imports can appear after bindings and before ; references. ; @@ -430,7 +449,7 @@ ; exporting-spec: (seq (* (or (export _) (export-syntax _ _) (export-syntaxes _ _))) (* (re-export _)) refs+subexps) ; unscoped-spec: refs+subexps ; refs+subexps: (* (or (ref _) (nest _ unscoped-spec) (nest-one _ unscoped-spec) (scope scoped-spec))) -; scoped-spec: (seq (* (or (bind-syntax _ _) (bind-syntaxes _ _) (bind _))) (? (recs _)) refs+subexps) +; scoped-spec: (seq (* (or (bind-syntax _ _) (bind-syntaxes _ _) (bind _))) (? (imports _)) refs+subexps) ; ; The implementation below separately implements refs+subexps for each context in which it occurs to ; provide specific error messages. @@ -462,10 +481,10 @@ [(or (s* ref) (s* suspend)) (void)] [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx)) (binding-scope-error stx)] - [(or (and (s* rec) (with-stx stx)) - (recs (cons (and (s* rec) (with-stx stx)) _))) + [(or (and (s* import) (with-stx stx)) + (imports (cons (and (s* import) (with-stx stx)) _))) (wrong-syntax/orig stx "import binding groups must occur within a scope")] - [(recs (list)) + [(imports (list)) ; impossible (void)] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) @@ -492,9 +511,9 @@ (export-context-error stx)] [(and (s* re-export) (with-stx stx)) (re-export-context-error stx)] - [(s* rec) + [(s* import) (check-sequence refs+subexps specs)] - [(s* recs) + [(s* imports) (check-sequence refs+subexps specs)] [_ (check-sequence refs+subexps (cons spec specs))])) @@ -508,10 +527,10 @@ (export-context-error stx)] [(and (s* re-export) (with-stx stx)) (re-export-context-error stx)] - [(or (and (s* rec) (with-stx stx)) - (recs (cons (and (s* rec) (with-stx stx)) _))) + [(or (and (s* import) (with-stx stx)) + (imports (cons (and (s* import) (with-stx stx)) _))) (wrong-syntax/orig stx "an import binding group must appear before references and subexpressions")] - [(recs (list)) + [(imports (list)) ; impossible (void)] [(or (s* ref) (s* suspend)) @@ -554,10 +573,10 @@ (wrong-syntax/orig stx "exports must appear first in a exporting spec")] [(and (s* re-export) (with-stx stx)) (wrong-syntax/orig stx "re-exports must occur before references and subexpressions")] - [(or (and (s* rec) (with-stx stx)) - (recs (cons (and (s* rec) (with-stx stx)) _))) + [(or (and (s* import) (with-stx stx)) + (imports (cons (and (s* import) (with-stx stx)) _))) (wrong-syntax/orig stx "import must occur within a scope")] - [(recs (list)) + [(imports (list)) ; impossible (void)] [(or (s* ref) (s* suspend)) @@ -599,9 +618,9 @@ #`(group (list (bind-syntax '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] [(bind-syntaxes _ depth (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) #`(group (list (bind-syntaxes '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] - [(recs ss) + [(imports ss) (match ss - [(list (rec _ _ pvs) ...) + [(list (import _ pvs) ...) (define/syntax-parse (s-cp1 ...) (for/list ([pv pvs]) (match pv @@ -614,9 +633,9 @@ ;; avoid adding the local-scopes to syntax moved in by first pass expansion #`(subexp/no-scope '#,v #,pass2-expander)]))) #'(group (list s-cp1 ... s-cp2 ...))] - [_ (error "unexpected specs in recs")])] - [(rec _ _ _) - (error "shouldn't encounter rec")] + [_ (error "unexpected specs in imports")])] + [(import _ _) + (error "shouldn't encounter import")] [(or (s* export) (s* export-syntax) (s* export-syntaxes)) (invariant-error 'compile-bspec-term/single-pass)] [(re-export _ (pvar v _)) diff --git a/tests/basic-langs/block.rkt b/tests/basic-langs/block.rkt index 85a2740..4894667 100644 --- a/tests/basic-langs/block.rkt +++ b/tests/basic-langs/block.rkt @@ -22,7 +22,7 @@ (host-interface/expression (block body:block-form ...) - #:binding (scope (import body ...)) + #:binding (scope (import body) ...) #'(compile-block body ...))) (define-syntax compile-block diff --git a/tests/basic-langs/define.rkt b/tests/basic-langs/define.rkt index b80e2a4..b685cd2 100644 --- a/tests/basic-langs/define.rkt +++ b/tests/basic-langs/define.rkt @@ -16,7 +16,7 @@ (dsl-+ e1:expr e2:expr) (dsl-lambda (v:var ...) d:def-or-expr ...) - #:binding (scope (bind v) ... (scope (import d ...))) + #:binding (scope (bind v) ... (scope (import d) ...)) (dsl-letrec-values ([(v:var ...) rhs:expr] ...) d:def-or-expr) #:binding (scope (bind v) ... ... rhs ... (scope (import d))) diff --git a/tests/dsls/js/js.rkt b/tests/dsls/js/js.rkt index 4fac188..e1263c2 100644 --- a/tests/dsls/js/js.rkt +++ b/tests/dsls/js/js.rkt @@ -61,7 +61,7 @@ (set! x:js-var e:js-expr) (function (x:js-var ...) body:js-stmt ...) - #:binding (scope (bind x) ... (scope (import body ...))) + #:binding (scope (bind x) ... (scope (import body) ...)) (e:js-expr e*:js-expr ...)) @@ -80,10 +80,10 @@ (return e:js-expr) (while c:js-expr body:js-stmt ...) - #:binding (scope (import body ...)) + #:binding (scope (import body) ...) (if c:js-expr (b1:js-stmt ...) (b2:js-stmt ...)) - #:binding [(scope (import b1 ...)) (scope (import b2 ...))] + #:binding [(scope (import b1) ...) (scope (import b2) ...)] e:js-expr)) diff --git a/tests/dsls/miniclass/class.rkt b/tests/dsls/miniclass/class.rkt index 7dd417b..78d380d 100644 --- a/tests/dsls/miniclass/class.rkt +++ b/tests/dsls/miniclass/class.rkt @@ -55,7 +55,7 @@ (host-interface/expression (class e:class-form ...) - #:binding (scope (import e ...)) + #:binding (scope (import e) ...) (define-values (defns fields exprs) (group-class-decls (splice-begins (attribute e)))) (compile-class-body defns fields exprs))) diff --git a/tests/dsls/simply-typed-lambda-calculus.rkt b/tests/dsls/simply-typed-lambda-calculus.rkt index 9b1fb11..a8d32eb 100644 --- a/tests/dsls/simply-typed-lambda-calculus.rkt +++ b/tests/dsls/simply-typed-lambda-calculus.rkt @@ -36,7 +36,7 @@ (rkt e:racket-expr (~datum :) t:type) (block d:typed-definition-or-expr ... e:typed-expr) - #:binding (scope (import d ...) e) + #:binding (scope (import d) ... e) ; rewrite for tagging applications (~> (fun arg ...) diff --git a/tests/dsls/state-machine-for-tutorial.rkt b/tests/dsls/state-machine-for-tutorial.rkt index dd30579..866c0be 100644 --- a/tests/dsls/state-machine-for-tutorial.rkt +++ b/tests/dsls/state-machine-for-tutorial.rkt @@ -28,7 +28,7 @@ (host-interface/expression (machine #:initial initial-state:state-name s:state-spec ...) - #:binding (scope (import s ...) initial-state) + #:binding (scope (import s) ... initial-state) (check-for-inaccessible-states #'initial-state (attribute s)) #'(compile-machine initial-state s ...))) diff --git a/tests/dsls/state-machine-oo/state-machine.rkt b/tests/dsls/state-machine-oo/state-machine.rkt index 1b1c983..1487700 100644 --- a/tests/dsls/state-machine-oo/state-machine.rkt +++ b/tests/dsls/state-machine-oo/state-machine.rkt @@ -9,7 +9,7 @@ (host-interface/expression (machine #:initial-state s:state-name d:machine-decl ...) - #:binding (scope (import d ...) s) + #:binding (scope (import d) ... s) #'(compile-machine s d ...)) (nonterminal/exporting machine-decl diff --git a/tests/errors.rkt b/tests/errors.rkt index 9682df1..805c1ac 100644 --- a/tests/errors.rkt +++ b/tests/errors.rkt @@ -148,25 +148,6 @@ (block d:def e:expr) #:binding (scope e (import d))))) -(check-decl-error - #rx"import cannot contain more than one ellipsis" - (syntax-spec - (nonterminal/exporting decl - ()) - (nonterminal expr - (m (d:decl ...) ...) - #:binding (import d ... ...)))) - -(check-decl-error - #rx"import cannot contain more than one ellipsis" - (syntax-spec - (nonterminal/exporting decl - ()) - (nonterminal expr - (m (d:decl ...) ...) - ; this one tests that we get the error even on [(import ...) ...] ~> (import ... ...) - #:binding [(import d ...) ...]))) - (check-decl-error #rx"nest cannot contain more than one ellipsis" (syntax-spec diff --git a/tests/multi-import.rkt b/tests/multi-import.rkt index c18dee4..83236af 100644 --- a/tests/multi-import.rkt +++ b/tests/multi-import.rkt @@ -11,17 +11,22 @@ (host-interface/expression (double-local ([d1:defn ...] [d2:defn ...]) body:racket-expr) - #:binding (scope (import d1 ...) (import d2 ...) body) - #'(compile-expr ([d1 ...] [d2 ...]) body))) + #:binding (scope (import d1) ... (import d2) ... body) + #'(compile-expr ([d1 ...] [d2 ...]) body)) + + (host-interface/expression + (many-local ([d:defn ...] ...) body:racket-expr) + ; this group is unnecessary, but we want to test the behavior of ellipsized groups with imports + #:binding (scope [[[[(import d)]] ...] ...] body) + #'(compile-expr ([d ...] ...) body))) (define-syntax compile-expr (syntax-parser #:literals (define) - [(_ ([(define x1 e1) ...] [(define x2 e2) ...]) body) + [(_ ([(define x e1) ...] ...) body) #'(let () - (define x1 e1) + (define x e1) ... - (define x2 e2) ... body)])) diff --git a/tests/nest-use-site-scope.rkt b/tests/nest-use-site-scope.rkt index 89ef3a1..17e9363 100644 --- a/tests/nest-use-site-scope.rkt +++ b/tests/nest-use-site-scope.rkt @@ -31,7 +31,7 @@ (syntax-spec (nonterminal my-expr (block d:my-def ...) - #:binding (scope (import d ...))) + #:binding (scope [(import d) ...])) (nonterminal/exporting my-def ((~literal define-syntax) x:pat-macro e:expr) From 47917ef737d58df1eb1df1cf71b5c0d8bebcd7ce Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sat, 28 Sep 2024 10:45:02 -0400 Subject: [PATCH 16/25] ellipsis homogeneity check --- private/syntax/compile/binding-spec.rkt | 70 +++++++++++++++++++++++++ tests/errors.rkt | 12 +++++ 2 files changed, 82 insertions(+) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index 80679fe..58735c5 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -31,6 +31,7 @@ (define bspec-elaborated (elaborate-bspec bspec-stx)) (check-affine-pvar-use! bspec-elaborated) (check-ellipsis-depth bspec-elaborated) + (check-ellipsis-homogeneity! bspec-elaborated) (define bspec-with-implicits (add-implicit-pvar-refs bspec-elaborated bound-pvars)) (define bspec-flattened (bspec-flatten-groups bspec-with-implicits)) ; might need to re-flatten after distributing @@ -324,6 +325,75 @@ [(< bs-depth ss-depth) (wrong-syntax/orig v "missing ellipses with pattern variable in binding spec")])) +; makes sure you don't mix categories like refs+subexps and binds in the same ellipsis +(define (check-ellipsis-homogeneity! bspec) + (map-bspec + (lambda (bspec) + (match bspec + [(ellipsis stx spec) + (define ref+subexp (find-immediate-ref+subexp spec)) + (define bind (find-immediate-bind spec)) + (define import (find-immediate-import spec)) + (define export (find-immediate-export spec)) + (define representatives (filter values (list ref+subexp bind import export))) + (when (< 1 (length representatives)) + (wrong-syntax/orig stx "cannot mix different binding spec categories inside of ellipses")) + bspec] + [_ bspec])) + bspec)) + +; BSpec -> (or/c #f BSpec) +; finds a ref or a subexp. doesn't recur into scopes +(define (find-immediate-ref+subexp bspec) + (match bspec + [(or (s* ref) + (s* scope) + (s* nest) + (s* nest-one)) + bspec] + [(group specs) + (findf find-immediate-ref+subexp specs)] + [(ellipsis _ spec) (find-immediate-ref+subexp spec)] + [_ #f])) + +; BSpec -> (or/c #f BSpec) +; finds a bind. doesn't recur into scopes +(define (find-immediate-bind bspec) + (match bspec + [(or (s* bind) + (s* bind-syntax) + (s* bind-syntaxes)) + bspec] + [(group specs) + (findf find-immediate-bind specs)] + [(ellipsis _ spec) (find-immediate-bind spec)] + [_ #f])) + +; BSpec -> (or/c #f BSpec) +; finds an import. doesn't recur into scopes +(define (find-immediate-import bspec) + (match bspec + [(or (s* import) + (s* imports)) + bspec] + [(group specs) + (findf find-immediate-import specs)] + [(ellipsis _ spec) (find-immediate-import spec)] + [_ #f])) + +; BSpec -> (or/c #f BSpec) +; finds an export. doesn't recur into scopes +(define (find-immediate-export bspec) + (match bspec + [(or (s* export) + (s* export-syntax) + (s* export-syntaxes)) + bspec] + [(group specs) + (findf find-immediate-export specs)] + [(ellipsis _ spec) (find-immediate-export spec)] + [_ #f])) + ;; Infer implicit pvar refs (define (add-implicit-pvar-refs bspec bound-pvars) diff --git a/tests/errors.rkt b/tests/errors.rkt index 805c1ac..f527fc9 100644 --- a/tests/errors.rkt +++ b/tests/errors.rkt @@ -158,6 +158,18 @@ ; this one tests that we get the error even on [(import ...) ...] ~> (import ... ...) #:binding (nest d ... ... [])))) + +(check-decl-error + #rx"cannot mix different binding spec categories inside of ellipses" + (syntax-spec + (nonterminal my-expr + (my-letrec ([x:racket-var e:racket-expr] ...) body:racket-expr) + #:binding (scope [(bind x) e] ... body)) + (nonterminal expr + (m (b:binding ...) ...) + ; this one tests that we get the error even on [(import ...) ...] ~> (import ... ...) + #:binding (nest d ... ... [])))) + (check-decl-error #rx"exports must appear first in a exporting spec" (syntax-spec From 39239dbe9220c1490634e72155793d847a91b080 Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sat, 28 Sep 2024 11:41:27 -0400 Subject: [PATCH 17/25] document ellipsis homogeneity and other constraints --- scribblings/reference/specifying.scrbl | 38 ++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/scribblings/reference/specifying.scrbl b/scribblings/reference/specifying.scrbl index 5e49b46..d3bfffc 100644 --- a/scribblings/reference/specifying.scrbl +++ b/scribblings/reference/specifying.scrbl @@ -420,6 +420,44 @@ Similar to syntax patterns and templates, syntax specs and binding specs have a } ] +There are several other constraints on binding specs: + +@itemlist[ +@item{ + Specs of different categories cannot occur within the same ellipsis. The categories of specs are: + @itemlist[ + @item{ + @racket[refs+subexps] include references, @racket[nest], and @racket[scope]. + } + @item{ + @racket[binds] include @racket[bind], @racket[bind-syntax], and @racket[bind-syntaxes]. + } + @item{ + @racket[imports] include @racket[import]. + } + @item{ + @racket[exports] include @racket[export], @racket[export-syntax], @racket[export-syntaxes], and @racket[re-export]. + } + ] + For example, the spec @racket[(scope [(bind x) e] ...)] is illegal since it mixes @racket[refs+subexps] and @racket[binds] in an ellipsis. +} +@item{ + @racket[binds] and @racket[imports] can only occur within a @racket[scope] +} +@item{ + @racket[exports] cannot occur within a scope. +} +@item{ + Within a scope, there can be zero or more @racket[binds], followed by zero or more @racket[imports], followed by zero or more @racket[refs+subexps]. +} +@item{ + The second argument to nest must be @racket[refs+subexps]. +} +@item{ + Spec variables can be used at most once. For example, @racket[(scope (bind x) e e)] is illegal. +} +] + @section{Host interface forms} Host interface forms are the entry point to the DSL from the host language. They often invoke a compiler macro to translate From 5a201ba64a81ca4857bbfdff9cb0c34d4e49c2dc Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sun, 29 Sep 2024 01:59:55 -0400 Subject: [PATCH 18/25] compile complex import groups --- private/syntax/compile/binding-spec.rkt | 134 ++++++++++++------------ tests/errors.rkt | 2 +- 2 files changed, 67 insertions(+), 69 deletions(-) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index 58735c5..248c007 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -30,14 +30,11 @@ (define bspec-elaborated (elaborate-bspec bspec-stx)) (check-affine-pvar-use! bspec-elaborated) - (check-ellipsis-depth bspec-elaborated) + (check-ellipsis-depth! bspec-elaborated) (check-ellipsis-homogeneity! bspec-elaborated) (define bspec-with-implicits (add-implicit-pvar-refs bspec-elaborated bound-pvars)) (define bspec-flattened (bspec-flatten-groups bspec-with-implicits)) - ; might need to re-flatten after distributing - (define bspec-distributed-ellipses (bspec-flatten-groups (bspec-distribute-ellipses bspec-flattened))) - (define bspec-absorbed-ellipses (bspec-absorb-ellipses-into-imports bspec-distributed-ellipses)) - (define bspec-combined-imports (bspec-combine-imports bspec-absorbed-ellipses)) + (define bspec-combined-imports (bspec-combine-imports bspec-flattened)) (syntax-parse variant [(~or #:simple (#:nesting _)) @@ -63,6 +60,7 @@ (struct import with-stx [pvar] #:transparent) ; no surface syntax, just a mechanism to combine imports ; something like [(import x) (import y)] ~> (imports (list (import x) (import y))) +; list may contain groups and ellipses of imports, not necessarily just imports (struct imports [specs] #:transparent) (struct re-export with-stx [pvar] #:transparent) (struct export with-stx [pvar] #:transparent) @@ -283,7 +281,7 @@ (when maybe-dup (wrong-syntax/orig maybe-dup "each pattern variable must occur in the binding spec at most once"))) -(define (check-ellipsis-depth bspec) +(define (check-ellipsis-depth! bspec) (let loop ([bspec bspec] [depth 0]) (match bspec [(ref (pvar v _)) @@ -331,10 +329,10 @@ (lambda (bspec) (match bspec [(ellipsis stx spec) - (define ref+subexp (find-immediate-ref+subexp spec)) - (define bind (find-immediate-bind spec)) - (define import (find-immediate-import spec)) - (define export (find-immediate-export spec)) + (define ref+subexp (find-ref+subexp spec)) + (define bind (find-bind spec)) + (define import (find-import spec)) + (define export (find-export spec)) (define representatives (filter values (list ref+subexp bind import export))) (when (< 1 (length representatives)) (wrong-syntax/orig stx "cannot mix different binding spec categories inside of ellipses")) @@ -344,54 +342,55 @@ ; BSpec -> (or/c #f BSpec) ; finds a ref or a subexp. doesn't recur into scopes -(define (find-immediate-ref+subexp bspec) +(define (find-ref+subexp bspec) (match bspec [(or (s* ref) + (s* suspend) (s* scope) (s* nest) (s* nest-one)) bspec] [(group specs) - (findf find-immediate-ref+subexp specs)] - [(ellipsis _ spec) (find-immediate-ref+subexp spec)] + (findf find-ref+subexp specs)] + [(ellipsis _ spec) (find-ref+subexp spec)] [_ #f])) ; BSpec -> (or/c #f BSpec) ; finds a bind. doesn't recur into scopes -(define (find-immediate-bind bspec) +(define (find-bind bspec) (match bspec [(or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) bspec] [(group specs) - (findf find-immediate-bind specs)] - [(ellipsis _ spec) (find-immediate-bind spec)] + (findf find-bind specs)] + [(ellipsis _ spec) (find-bind spec)] [_ #f])) ; BSpec -> (or/c #f BSpec) ; finds an import. doesn't recur into scopes -(define (find-immediate-import bspec) +(define (find-import bspec) (match bspec [(or (s* import) (s* imports)) bspec] [(group specs) - (findf find-immediate-import specs)] - [(ellipsis _ spec) (find-immediate-import spec)] + (findf find-import specs)] + [(ellipsis _ spec) (find-import spec)] [_ #f])) ; BSpec -> (or/c #f BSpec) ; finds an export. doesn't recur into scopes -(define (find-immediate-export bspec) +(define (find-export bspec) (match bspec [(or (s* export) (s* export-syntax) (s* export-syntaxes)) bspec] [(group specs) - (findf find-immediate-export specs)] - [(ellipsis _ spec) (find-immediate-export spec)] + (findf find-export specs)] + [(ellipsis _ spec) (find-export spec)] [_ #f])) ;; Infer implicit pvar refs @@ -435,8 +434,7 @@ (map-bspec (lambda (spec) (match spec - [(group (list spec)) spec] - [(group l) (group (append* (map flat-bspec-top-elements l)))] + [(group l) (group (append* (map flat-bspec-top-elements l)))] [_ spec])) bspec)) @@ -445,38 +443,15 @@ [(group l) l] [_ (list el)])) -; convert ([a b c] ...) to [a ... b ... c ...] -(define (bspec-distribute-ellipses bspec) - (map-bspec - (lambda (spec) - (match spec - [(ellipsis stx (group specs)) - (group (for/list ([spec specs]) (ellipsis stx spec)))] - [_ spec])) - bspec)) - -; convert ((import x) ...) to (import x) -; only do this after checking ellipses since it erases them -(define (bspec-absorb-ellipses-into-imports bspec) - (map-bspec - (lambda (spec) - (match spec - [(ellipsis _ (import stx pv)) - (import stx pv)] - [_ spec])) - bspec)) - ; combine consecutive imports in a group (define (bspec-combine-imports bspec) (map-bspec (lambda (spec) (match spec - [(scope stx (and imp (s* import))) - (scope stx (imports (list imp)))] [(group l) (group (let loop ([l l]) (match l - [(list (and imps (s* import)) ..1 ss ...) + [(list (and imps (? find-import)) ..1 ss ...) (cons (imports imps) (loop ss))] [(cons s ss) (cons s (loop ss))] @@ -536,16 +511,17 @@ (wrong-syntax/orig stx "binding must occur within a scope")) (define (export-context-error stx) - (wrong-syntax/orig stx "exports may only occur at the top-level of a exporting binding spec")) + (wrong-syntax/orig stx "exports may only occur at the top-level of an exporting binding spec")) (define (re-export-context-error stx) - (wrong-syntax/orig stx "re-exports may only occur at the top-level of a exporting binding spec")) + (wrong-syntax/orig stx "re-exports may only occur at the top-level of an exporting binding spec")) ; spec -> (void) or raised syntax error ; enforces the above grammar for an unscoped expression (define (check-order/unscoped-expression spec) - (define (refs+subexps spec) + (let refs+subexps ([spec spec]) (match spec + [(group specs) (map refs+subexps specs)] [(s* ellipsis [spec s]) (refs+subexps s)] [(or (s* ref) (s* suspend)) (void)] @@ -565,8 +541,7 @@ (s* nest-one [spec s])) (check-order/unscoped-expression s)] [(s* scope [spec s]) - (check-order/scoped-expression s)])) - (map refs+subexps (flat-bspec-top-elements spec))) + (check-order/scoped-expression s)]))) #;(BSpec -> void?) ; enforces the above grammar for a scoped expression @@ -689,21 +664,9 @@ [(bind-syntaxes _ depth (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) #`(group (list (bind-syntaxes '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] [(imports ss) - (match ss - [(list (import _ pvs) ...) - (define/syntax-parse (s-cp1 ...) - (for/list ([pv pvs]) - (match pv - [(pvar v (nonterm-rep (exporting-nonterm-info pass1-expander _))) - #`(subexp '#,v #,pass1-expander)]))) - (define/syntax-parse (s-cp2 ...) - (for/list ([pv pvs]) - (match pv - [(pvar v (nonterm-rep (exporting-nonterm-info _ pass2-expander))) - ;; avoid adding the local-scopes to syntax moved in by first pass expansion - #`(subexp/no-scope '#,v #,pass2-expander)]))) - #'(group (list s-cp1 ... s-cp2 ...))] - [_ (error "unexpected specs in imports")])] + (define/syntax-parse (s-cp1 ...) (map compile-import/pass1 ss)) + (define/syntax-parse (s-cp2 ...) (map compile-import/pass2 ss)) + #'(group (list s-cp1 ... s-cp2 ...))] [(import _ _) (error "shouldn't encounter import")] [(or (s* export) (s* export-syntax) (s* export-syntaxes)) @@ -731,6 +694,41 @@ (with-syntax ([spec-c (compile-bspec-term/single-pass spec)]) #`(ellipsis '#,vs spec-c))])) +; BSpec -> Syntax +; spec can be groups, ellipses, and imports +(define (compile-import/pass1 spec) + (match spec + [(import _ pv) + (match pv + [(pvar v (nonterm-rep (exporting-nonterm-info pass1-expander _))) + #`(subexp '#,v #,pass1-expander)])] + [(ellipsis _ spec) + (define vs (bspec-referenced-pvars spec)) + (with-syntax ([spec-c (compile-import/pass1 spec)]) + #`(ellipsis '#,vs spec-c))] + [(or (imports specs) (group specs)) + (with-syntax ([(spec-c ...) (map compile-import/pass1 specs)]) + #'(group (list spec-c ...)))] + [_ (error "unexpected specs in imports")])) + +; BSpec -> Syntax +; spec can be groups, ellipses, and imports +(define (compile-import/pass2 spec) + (match spec + [(import _ pv) + (match pv + [(pvar v (nonterm-rep (exporting-nonterm-info _ pass2-expander))) + ;; avoid adding the local-scopes to syntax moved in by first pass expansion + #`(subexp/no-scope '#,v #,pass2-expander)])] + [(ellipsis _ spec) + (define vs (bspec-referenced-pvars spec)) + (with-syntax ([spec-c (compile-import/pass2 spec)]) + #`(ellipsis '#,vs spec-c))] + [(or (imports specs) (group specs)) + (with-syntax ([(spec-c ...) (map compile-import/pass2 specs)]) + #'(group (list spec-c ...)))] + [_ (error "unexpected specs in imports")])) + (define no-op #'(group (list))) (define (compile-bspec-term/pass1 spec) diff --git a/tests/errors.rkt b/tests/errors.rkt index f527fc9..7f91b05 100644 --- a/tests/errors.rkt +++ b/tests/errors.rkt @@ -103,7 +103,7 @@ (check-decl-error - #rx"nonterminal: exports may only occur at the top-level of a exporting binding spec" + #rx"nonterminal: exports may only occur at the top-level of an exporting binding spec" (syntax-spec (binding-class var #:description "var") (nonterminal expr From 3253a6e2bee8bc5ac59ae53cf430f5e38fd2d7ed Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sun, 29 Sep 2024 02:19:26 -0400 Subject: [PATCH 19/25] handle groups in order checks --- private/syntax/compile/binding-spec.rkt | 20 ++++++++++++++++++++ tests/group-ellipsis.rkt | 16 ++++++++++++++++ 2 files changed, 36 insertions(+) create mode 100644 tests/group-ellipsis.rkt diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index 248c007..d7491b5 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -550,6 +550,10 @@ (match spec [(s* ellipsis [spec s]) (bindings s specs)] + [(group (cons group-spec group-specs)) + ; inline flatten + (bindings group-spec (append group-specs specs))] + [(group (list)) (check-sequence bindings specs)] [(or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (check-sequence bindings specs)] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) @@ -566,6 +570,10 @@ (match spec [(s* ellipsis [spec s]) (refs+subexps s specs)] + [(group (cons group-spec group-specs)) + ; inline flatten + (refs+subexps group-spec (append group-specs specs))] + [(group (list)) (check-sequence refs+subexps specs)] [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx)) (wrong-syntax/orig stx "bindings must appear first within a scope")] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) @@ -595,6 +603,10 @@ (match spec [(s* ellipsis [spec s]) (exports s specs)] + [(group (cons group-spec group-specs)) + ; inline flatten + (exports group-spec (append group-specs specs))] + [(group (list)) (check-sequence exports specs)] [(or (s* export) (s* export-syntax) (s* export-syntaxes)) (check-sequence exports specs)] [_ (check-sequence re-exports (cons spec specs))])) @@ -603,6 +615,10 @@ (match spec [(s* ellipsis [spec s]) (re-exports s specs)] + [(group (cons group-spec group-specs)) + ; inline flatten + (re-exports group-spec (append group-specs specs))] + [(group (list)) (check-sequence re-exports specs)] [(s* re-export) (check-sequence re-exports specs)] [_ @@ -612,6 +628,10 @@ (match spec [(s* ellipsis [spec s]) (refs+subexps s specs)] + [(group (cons group-spec group-specs)) + ; inline flatten + (refs+subexps group-spec (append group-specs specs))] + [(group (list)) (check-sequence refs+subexps specs)] [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx)) (binding-scope-error stx)] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) diff --git a/tests/group-ellipsis.rkt b/tests/group-ellipsis.rkt new file mode 100644 index 0000000..a7fa989 --- /dev/null +++ b/tests/group-ellipsis.rkt @@ -0,0 +1,16 @@ +#lang racket/base + +; testing edge cases with ellipses and groups + +(require "../testing.rkt") + +; the test is just that this compiles +(syntax-spec + (nonterminal my-expr + (my-let ([x:racket-var e:racket-expr] ...) body:racket-expr ...) + #:binding [[e] ... (scope [(bind x)] ... [body] ...)] + (my-imporing d:my-exporting ...) + #:binding (scope [(import d)] ...)) + (nonterminal/exporting my-exporting + (my-define-values (x:racket-var ...)) + #:binding [[(export x)] ...])) From 2faaed5f18a7344a036498266056d7c0e4a73e11 Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sun, 29 Sep 2024 02:27:32 -0400 Subject: [PATCH 20/25] no more recursive flatten for order, test groups and ellipses --- private/syntax/compile/binding-spec.rkt | 17 +---------------- 1 file changed, 1 insertion(+), 16 deletions(-) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index d7491b5..b8fde5b 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -33,8 +33,7 @@ (check-ellipsis-depth! bspec-elaborated) (check-ellipsis-homogeneity! bspec-elaborated) (define bspec-with-implicits (add-implicit-pvar-refs bspec-elaborated bound-pvars)) - (define bspec-flattened (bspec-flatten-groups bspec-with-implicits)) - (define bspec-combined-imports (bspec-combine-imports bspec-flattened)) + (define bspec-combined-imports (bspec-combine-imports bspec-with-implicits)) (syntax-parse variant [(~or #:simple (#:nesting _)) @@ -428,16 +427,6 @@ (append* node-vars children)) spec)) -;; Flatten groups for easier order analysis - -(define (bspec-flatten-groups bspec) - (map-bspec - (lambda (spec) - (match spec - [(group l) (group (append* (map flat-bspec-top-elements l)))] - [_ spec])) - bspec)) - (define (flat-bspec-top-elements el) (match el [(group l) l] @@ -551,7 +540,6 @@ [(s* ellipsis [spec s]) (bindings s specs)] [(group (cons group-spec group-specs)) - ; inline flatten (bindings group-spec (append group-specs specs))] [(group (list)) (check-sequence bindings specs)] [(or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) @@ -604,7 +592,6 @@ [(s* ellipsis [spec s]) (exports s specs)] [(group (cons group-spec group-specs)) - ; inline flatten (exports group-spec (append group-specs specs))] [(group (list)) (check-sequence exports specs)] [(or (s* export) (s* export-syntax) (s* export-syntaxes)) @@ -616,7 +603,6 @@ [(s* ellipsis [spec s]) (re-exports s specs)] [(group (cons group-spec group-specs)) - ; inline flatten (re-exports group-spec (append group-specs specs))] [(group (list)) (check-sequence re-exports specs)] [(s* re-export) @@ -629,7 +615,6 @@ [(s* ellipsis [spec s]) (refs+subexps s specs)] [(group (cons group-spec group-specs)) - ; inline flatten (refs+subexps group-spec (append group-specs specs))] [(group (list)) (check-sequence refs+subexps specs)] [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx)) From f47e2057da0381ee39e8c96c978715c5d889652a Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Sun, 29 Sep 2024 16:42:18 -0400 Subject: [PATCH 21/25] test that nested has ellipsis depth 0 fixes #39 --- tests/errors.rkt | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/errors.rkt b/tests/errors.rkt index 7f91b05..8d1f943 100644 --- a/tests/errors.rkt +++ b/tests/errors.rkt @@ -223,6 +223,13 @@ (foo a:racket-var) #:binding [a ...]))) +(check-decl-error + #rx"nonterminal/nesting: too many ellipses for pattern variable in binding spec" + (syntax-spec + (nonterminal/nesting expr (nested) + (foo a:racket-var) + #:binding (scope (bind a) nested ...)))) + ;; ;; Valid definitions used to exercise errors ;; From b53946fc7d61a6fa3dab6be6086a3f1c90708f79 Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Wed, 9 Oct 2024 14:03:57 -0700 Subject: [PATCH 22/25] all elaborated spec structs have stx --- private/syntax/compile/binding-spec.rkt | 117 ++++++++++++------------ tests/errors.rkt | 11 +++ 2 files changed, 71 insertions(+), 57 deletions(-) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index b8fde5b..be89703 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -52,7 +52,7 @@ (struct with-stx [stx]) ;; A BSpec is one of -(struct ref [pvar] #:transparent) +(struct ref with-stx [pvar] #:transparent) (struct bind with-stx [pvar] #:transparent) (struct bind-syntax with-stx [pvar transformer-pvar] #:transparent) (struct bind-syntaxes with-stx [depth pvar transformer-pvar] #:transparent) @@ -60,7 +60,7 @@ ; no surface syntax, just a mechanism to combine imports ; something like [(import x) (import y)] ~> (imports (list (import x) (import y))) ; list may contain groups and ellipses of imports, not necessarily just imports -(struct imports [specs] #:transparent) +(struct imports with-stx [specs] #:transparent) (struct re-export with-stx [pvar] #:transparent) (struct export with-stx [pvar] #:transparent) (struct export-syntax with-stx [pvar transformer-pvar] #:transparent) @@ -70,7 +70,7 @@ (struct suspend with-stx [pvar] #:transparent) (struct scope with-stx [spec] #:transparent) (struct ellipsis with-stx [spec] #:transparent) -(struct group [specs] #:transparent) +(struct group with-stx [specs] #:transparent) (define-match-expander s* (syntax-parser @@ -90,12 +90,12 @@ [(scope stx s) (let ([s^ (map-bspec f s)]) (f (scope stx s^)))] - [(group ss) + [(group stx ss) (let ([ss^ (map (lambda (s) (map-bspec f s)) ss)]) - (f (group ss^)))] - [(imports ss) + (f (group stx ss^)))] + [(imports stx ss) (let ([ss^ (map (lambda (s) (map-bspec f s)) ss)]) - (f (imports ss^)))] + (f (imports stx ss^)))] [(ellipsis stx s) (f (ellipsis stx (map-bspec f s)))] [_ (f spec)])) @@ -110,7 +110,7 @@ (s* ellipsis [spec s])) (let ([s^ (fold-bspec f s)]) (f spec (list s^)))] - [(or (imports ss) (group ss)) + [(or (imports _ ss) (group _ ss)) (let ([ss^ (map (lambda (s) (fold-bspec f s)) ss)]) (f spec ss^))] [_ (f spec '())])) @@ -211,10 +211,10 @@ (pvar (attribute v) (lookup-pvar (attribute v))))] [(scope ~! spec ...) (scope - this-syntax - (group (elaborate-group (attribute spec))))] + #'(spec ...) + (group this-syntax (elaborate-group (attribute spec))))] [(spec ...) - (group (elaborate-group (attribute spec)))])) + (group this-syntax (elaborate-group (attribute spec)))])) ; (Listof Syntax) -> (Listof BSpec) ; handles ellipses @@ -234,10 +234,10 @@ #;(identifier? -> BSpec) (define (elaborate-ref v) - (ref (elaborate-pvar v - (or (s* bindclass-rep) (s* nonterm-rep) (? stxclass-rep?) (s* nested-binding) - (s* special-syntax-class-binding)) - "binding class, syntax class, or nonterminal"))) + (ref v (elaborate-pvar v + (or (s* bindclass-rep) (s* nonterm-rep) (? stxclass-rep?) (s* nested-binding) + (s* special-syntax-class-binding)) + "binding class, syntax class, or nonterminal"))) (define-syntax-rule (elaborate-pvar v-e pattern expected-str-e) @@ -283,7 +283,7 @@ (define (check-ellipsis-depth! bspec) (let loop ([bspec bspec] [depth 0]) (match bspec - [(ref (pvar v _)) + [(ref _ (pvar v _)) (check-ellipsis-depth/pvar depth v)] [(or (export stx (pvar v _)) (re-export stx (pvar v _)) @@ -300,7 +300,7 @@ (check-ellipsis-depth/pvar depth tv stx)] [(import stx (pvar v _)) (check-ellipsis-depth/pvar depth v stx)] - [(or (group ss) (imports ss)) + [(or (group _ ss) (imports _ ss)) (for ([s ss]) (loop s depth))] [(nest stx nest-depth (pvar v _) s) @@ -349,7 +349,7 @@ (s* nest) (s* nest-one)) bspec] - [(group specs) + [(group _ specs) (findf find-ref+subexp specs)] [(ellipsis _ spec) (find-ref+subexp spec)] [_ #f])) @@ -362,7 +362,7 @@ (s* bind-syntax) (s* bind-syntaxes)) bspec] - [(group specs) + [(group _ specs) (findf find-bind specs)] [(ellipsis _ spec) (find-bind spec)] [_ #f])) @@ -374,7 +374,7 @@ [(or (s* import) (s* imports)) bspec] - [(group specs) + [(group _ specs) (findf find-import specs)] [(ellipsis _ spec) (find-import spec)] [_ #f])) @@ -387,7 +387,7 @@ (s* export-syntax) (s* export-syntaxes)) bspec] - [(group specs) + [(group _ specs) (findf find-export specs)] [(ellipsis _ spec) (find-export spec)] [_ #f])) @@ -401,7 +401,8 @@ bound-pvars bound-identifier=?)) - (group (cons bspec (for/list ([v unreferenced-pvars]) + (group (with-stx-stx bspec) + (cons bspec (for/list ([v unreferenced-pvars]) (elaborate-ref v))))) (define (bspec-referenced-pvars spec) @@ -429,7 +430,7 @@ (define (flat-bspec-top-elements el) (match el - [(group l) l] + [(group _ l) l] [_ (list el)])) ; combine consecutive imports in a group @@ -437,14 +438,15 @@ (map-bspec (lambda (spec) (match spec - [(group l) - (group (let loop ([l l]) - (match l - [(list (and imps (? find-import)) ..1 ss ...) - (cons (imports imps) (loop ss))] - [(cons s ss) - (cons s (loop ss))] - [(list) (list)])))] + [(group stx l) + (group stx (let loop ([l l]) + (match l + [(list (and imps (? find-import)) ..1 ss ...) + ; TODO combine srclocs of imps instead of using group's stx + (cons (imports stx imps) (loop ss))] + [(cons s ss) + (cons s (loop ss))] + [(list) (list)])))] [_ spec])) bspec)) @@ -510,16 +512,17 @@ (define (check-order/unscoped-expression spec) (let refs+subexps ([spec spec]) (match spec - [(group specs) (map refs+subexps specs)] + [(group _ specs) (map refs+subexps specs)] [(s* ellipsis [spec s]) (refs+subexps s)] [(or (s* ref) (s* suspend)) (void)] [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx)) (binding-scope-error stx)] [(or (and (s* import) (with-stx stx)) - (imports (cons (and (s* import) (with-stx stx)) _))) + (imports _ (cons (with-stx stx) _))) + ; TODO use imports stx once it's sorce location is more refined. (wrong-syntax/orig stx "import binding groups must occur within a scope")] - [(imports (list)) + [(imports _ (list)) ; impossible (void)] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) @@ -539,9 +542,9 @@ (match spec [(s* ellipsis [spec s]) (bindings s specs)] - [(group (cons group-spec group-specs)) + [(group _ (cons group-spec group-specs)) (bindings group-spec (append group-specs specs))] - [(group (list)) (check-sequence bindings specs)] + [(group _ (list)) (check-sequence bindings specs)] [(or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (check-sequence bindings specs)] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) @@ -558,10 +561,10 @@ (match spec [(s* ellipsis [spec s]) (refs+subexps s specs)] - [(group (cons group-spec group-specs)) + [(group _ (cons group-spec group-specs)) ; inline flatten (refs+subexps group-spec (append group-specs specs))] - [(group (list)) (check-sequence refs+subexps specs)] + [(group _ (list)) (check-sequence refs+subexps specs)] [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx)) (wrong-syntax/orig stx "bindings must appear first within a scope")] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) @@ -569,9 +572,9 @@ [(and (s* re-export) (with-stx stx)) (re-export-context-error stx)] [(or (and (s* import) (with-stx stx)) - (imports (cons (and (s* import) (with-stx stx)) _))) + (imports _ (cons (and (s* import) (with-stx stx)) _))) (wrong-syntax/orig stx "an import binding group must appear before references and subexpressions")] - [(imports (list)) + [(imports _ (list)) ; impossible (void)] [(or (s* ref) (s* suspend)) @@ -591,9 +594,9 @@ (match spec [(s* ellipsis [spec s]) (exports s specs)] - [(group (cons group-spec group-specs)) + [(group _ (cons group-spec group-specs)) (exports group-spec (append group-specs specs))] - [(group (list)) (check-sequence exports specs)] + [(group _ (list)) (check-sequence exports specs)] [(or (s* export) (s* export-syntax) (s* export-syntaxes)) (check-sequence exports specs)] [_ (check-sequence re-exports (cons spec specs))])) @@ -602,9 +605,9 @@ (match spec [(s* ellipsis [spec s]) (re-exports s specs)] - [(group (cons group-spec group-specs)) + [(group _ (cons group-spec group-specs)) (re-exports group-spec (append group-specs specs))] - [(group (list)) (check-sequence re-exports specs)] + [(group _ (list)) (check-sequence re-exports specs)] [(s* re-export) (check-sequence re-exports specs)] [_ @@ -614,9 +617,9 @@ (match spec [(s* ellipsis [spec s]) (refs+subexps s specs)] - [(group (cons group-spec group-specs)) + [(group _ (cons group-spec group-specs)) (refs+subexps group-spec (append group-specs specs))] - [(group (list)) (check-sequence refs+subexps specs)] + [(group _ (list)) (check-sequence refs+subexps specs)] [(and (or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (with-stx stx)) (binding-scope-error stx)] [(and (or (s* export) (s* export-syntax) (s* export-syntaxes)) (with-stx stx)) @@ -624,9 +627,9 @@ [(and (s* re-export) (with-stx stx)) (wrong-syntax/orig stx "re-exports must occur before references and subexpressions")] [(or (and (s* import) (with-stx stx)) - (imports (cons (and (s* import) (with-stx stx)) _))) + (imports _ (cons (and (s* import) (with-stx stx)) _))) (wrong-syntax/orig stx "import must occur within a scope")] - [(imports (list)) + [(imports _ (list)) ; impossible (void)] [(or (s* ref) (s* suspend)) @@ -646,7 +649,7 @@ (define (compile-bspec-term/single-pass spec) (match spec - [(ref (pvar v info)) + [(ref _ (pvar v info)) (match info [(nonterm-rep (simple-nonterm-info exp-proc)) #`(subexp '#,v #,exp-proc)] @@ -668,7 +671,7 @@ #`(group (list (bind-syntax '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] [(bind-syntaxes _ depth (pvar v (extclass-rep constr _ _ space)) (pvar v-transformer _)) #`(group (list (bind-syntaxes '#,v '#,space #'#,constr '#,v-transformer) (rename-bind '#,v '#,space)))] - [(imports ss) + [(imports _ ss) (define/syntax-parse (s-cp1 ...) (map compile-import/pass1 ss)) (define/syntax-parse (s-cp2 ...) (map compile-import/pass2 ss)) #'(group (list s-cp1 ... s-cp2 ...))] @@ -691,7 +694,7 @@ [(scope _ spec) (with-syntax ([spec-c (compile-bspec-term/single-pass spec)]) #'(scope spec-c))] - [(group specs) + [(group _ specs) (with-syntax ([(spec-c ...) (map compile-bspec-term/single-pass specs)]) #'(group (list spec-c ...)))] [(ellipsis _ spec) @@ -711,7 +714,7 @@ (define vs (bspec-referenced-pvars spec)) (with-syntax ([spec-c (compile-import/pass1 spec)]) #`(ellipsis '#,vs spec-c))] - [(or (imports specs) (group specs)) + [(or (imports _ specs) (group _ specs)) (with-syntax ([(spec-c ...) (map compile-import/pass1 specs)]) #'(group (list spec-c ...)))] [_ (error "unexpected specs in imports")])) @@ -729,7 +732,7 @@ (define vs (bspec-referenced-pvars spec)) (with-syntax ([spec-c (compile-import/pass2 spec)]) #`(ellipsis '#,vs spec-c))] - [(or (imports specs) (group specs)) + [(or (imports _ specs) (group _ specs)) (with-syntax ([(spec-c ...) (map compile-import/pass2 specs)]) #'(group (list spec-c ...)))] [_ (error "unexpected specs in imports")])) @@ -740,11 +743,11 @@ (match spec [(or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (invariant-error 'compile-bspec-term/pass1)] - [(group specs) + [(group _ specs) (with-syntax ([(spec-c ...) (map compile-bspec-term/pass1 specs)]) #'(group (list spec-c ...)))] - [(or (ref _) + [(or (ref _ _) (nest _ _ _ _) (nest-one _ _ _) (scope _ _) @@ -769,11 +772,11 @@ (match spec [(or (s* bind) (s* bind-syntax) (s* bind-syntaxes)) (invariant-error 'compile-bspec-term/pass2)] - [(group specs) + [(group _ specs) (with-syntax ([(spec-c ...) (map compile-bspec-term/pass2 specs)]) #'(group (list spec-c ...)))] - [(or (ref _) + [(or (ref _ _) (nest _ _ _ _) (nest-one _ _ _) (scope _ _) diff --git a/tests/errors.rkt b/tests/errors.rkt index 8d1f943..e9d4e34 100644 --- a/tests/errors.rkt +++ b/tests/errors.rkt @@ -129,6 +129,17 @@ (block d:def) #:binding (import d)))) +(check-decl-error + #rx"nonterminal: import binding groups must occur within a scope" + (syntax-spec + (binding-class var #:description "var") + (nonterminal/exporting def + (define x:var e:expr) + #:binding [(export x) e]) + (nonterminal expr + (block d:def) + #:binding [(import d)]))) + (check-decl-error #rx"nonterminal: bindings must appear first within a scope" (syntax-spec From 444136216eb20292695f6c9f81fb003fcaf0cb4b Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Wed, 9 Oct 2024 16:59:17 -0700 Subject: [PATCH 23/25] re-introduce elaborated binding spec flattening necessary to guarantee that imports only contains imports by the time we reach the order check --- private/syntax/compile/binding-spec.rkt | 20 +++++++++++++++----- tests/group-ellipsis.rkt | 2 ++ 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/private/syntax/compile/binding-spec.rkt b/private/syntax/compile/binding-spec.rkt index be89703..cf8667b 100644 --- a/private/syntax/compile/binding-spec.rkt +++ b/private/syntax/compile/binding-spec.rkt @@ -33,7 +33,8 @@ (check-ellipsis-depth! bspec-elaborated) (check-ellipsis-homogeneity! bspec-elaborated) (define bspec-with-implicits (add-implicit-pvar-refs bspec-elaborated bound-pvars)) - (define bspec-combined-imports (bspec-combine-imports bspec-with-implicits)) + (define bspec-flattened (bspec-flatten-groups bspec-with-implicits)) + (define bspec-combined-imports (bspec-combine-imports bspec-flattened)) (syntax-parse variant [(~or #:simple (#:nesting _)) @@ -428,6 +429,16 @@ (append* node-vars children)) spec)) +;; Flatten groups for easier order analysis + +(define (bspec-flatten-groups bspec) + (map-bspec + (lambda (spec) + (match spec + [(group stx l) (group stx (append* (map flat-bspec-top-elements l)))] + [_ spec])) + bspec)) + (define (flat-bspec-top-elements el) (match el [(group _ l) l] @@ -551,9 +562,8 @@ (export-context-error stx)] [(and (s* re-export) (with-stx stx)) (re-export-context-error stx)] - [(s* import) - (check-sequence refs+subexps specs)] - [(s* imports) + [(or (s* import) (s* imports)) + ; assumes imports only contains imports, groups, and ellipses of imports by now (check-sequence refs+subexps specs)] [_ (check-sequence refs+subexps (cons spec specs))])) @@ -572,7 +582,7 @@ [(and (s* re-export) (with-stx stx)) (re-export-context-error stx)] [(or (and (s* import) (with-stx stx)) - (imports _ (cons (and (s* import) (with-stx stx)) _))) + (imports _ (cons (with-stx stx) _))) (wrong-syntax/orig stx "an import binding group must appear before references and subexpressions")] [(imports _ (list)) ; impossible diff --git a/tests/group-ellipsis.rkt b/tests/group-ellipsis.rkt index a7fa989..ecd4706 100644 --- a/tests/group-ellipsis.rkt +++ b/tests/group-ellipsis.rkt @@ -9,6 +9,8 @@ (nonterminal my-expr (my-let ([x:racket-var e:racket-expr] ...) body:racket-expr ...) #:binding [[e] ... (scope [(bind x)] ... [body] ...)] + (my-weird-let (d1:my-exporting ...) (d2:my-exporting ...) ([x:racket-var e:racket-expr] ...) b:racket-expr) + #:binding (scope [(bind x) ... (import d2) ...] (import d1) ...) (my-imporing d:my-exporting ...) #:binding (scope [(import d)] ...)) (nonterminal/exporting my-exporting From 676020d1f0f196e86009c57dfa7ce9b68fe14d4a Mon Sep 17 00:00:00 2001 From: Mike Delmonaco Date: Wed, 9 Oct 2024 17:27:03 -0700 Subject: [PATCH 24/25] add test case that depends on import order --- tests/multi-import.rkt | 67 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 66 insertions(+), 1 deletion(-) diff --git a/tests/multi-import.rkt b/tests/multi-import.rkt index 83236af..1f0a707 100644 --- a/tests/multi-import.rkt +++ b/tests/multi-import.rkt @@ -2,7 +2,8 @@ ; testing the combining of multiple imports into a single import group -(require "../testing.rkt") +(require "../testing.rkt" + syntax/macro-testing) (syntax-spec (nonterminal/exporting defn @@ -35,3 +36,67 @@ [(define even? (lambda (n) (or (zero? n) (odd? (sub1 n)))))]) (odd? 3)) #t) + +; another test + +(syntax-spec + (nonterminal/exporting def + #:allow-extension racket-macro + (mylet (d:def ...) (d2:def ...)) + #:binding (scope (import d) ... (import d2) ...) + (mylet2 (d:def ...) (d2:def ...)) + #:binding (scope [(import d) (import d2)] ...) + + (mydef x:racket-var e:racket-expr) + #:binding (export x) + + (mydefsyntax x:racket-macro e:expr) + #:binding (export-syntax x e) + + (myexpr e:racket-expr)) + (host-interface/expression + (mylang d:def) + #:binding (scope (import d)) + #''d)) + +(test-case "these expand" + (mylang + (mylet + [(myexpr 1) + (mydefsyntax mydef2 (syntax-rules () [(_ x e) (mydef x e)]))] + [(mydef2 x 5) + (myexpr 2)])) + + (mylang + (mylet2 + [(myexpr 2) + (mydef2 x 5)] + [(mydefsyntax mydef2 (syntax-rules () [(_ x e) (mydef x e)])) + (myexpr 1)])) + + (void)) + +(test-case "these don't expand" + (check-exn + #rx"expected def" + (lambda () + (convert-compile-time-error + (mylang + (mylet2 + [(myexpr 1) + (mydefsyntax mydef2 (syntax-rules () [(_ x e) (mydef x e)]))] + [(mydef2 x 5) + (myexpr 2)]))))) + + (check-exn + #rx"expected def" + (lambda () + (convert-compile-time-error + (mylang + (mylet + [(myexpr 2) + (mydef2 x 5)] + [(mydefsyntax mydef2 (syntax-rules () [(_ x e) (mydef x e)])) + (myexpr 1)]))))) + + (void)) From 5bafa7f81e82c0326ab79c3282c21b284c42c904 Mon Sep 17 00:00:00 2001 From: Michael Ballantyne Date: Fri, 11 Oct 2024 12:11:45 -0700 Subject: [PATCH 25/25] export ... ...+ --- main.rkt | 2 ++ tests/group-ellipsis.rkt | 8 +++++++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/main.rkt b/main.rkt index 469baed..b98f075 100644 --- a/main.rkt +++ b/main.rkt @@ -5,6 +5,8 @@ (for-syntax number id + ... + ...+ mutable-reference-compiler immutable-reference-compiler diff --git a/tests/group-ellipsis.rkt b/tests/group-ellipsis.rkt index ecd4706..7626e9d 100644 --- a/tests/group-ellipsis.rkt +++ b/tests/group-ellipsis.rkt @@ -2,7 +2,7 @@ ; testing edge cases with ellipses and groups -(require "../testing.rkt") +(require "../main.rkt") ; the test is just that this compiles (syntax-spec @@ -16,3 +16,9 @@ (nonterminal/exporting my-exporting (my-define-values (x:racket-var ...)) #:binding [[(export x)] ...])) + +; and this---here we're making sure ...+ works just like ... for depth checking +(syntax-spec + (nonterminal/exporting my-def + (my-def x:racket-var ...+ e:racket-expr) + #:binding [(export x) ...]))