diff --git a/libguile/macros.c b/libguile/macros.c index 70373e80b..e26ed651c 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -1,4 +1,4 @@ -/* Copyright 1995-1998,2000-2003,2006,2008-2012,2018 +/* Copyright 1995-1998,2000-2003,2006,2008-2012,2018-2019 Free Software Foundation, Inc. This file is part of Guile. @@ -64,6 +64,8 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate) return 1; } +SCM_SYMBOL (sym_primitive_macro, "primitive-macro"); + /* Return a mmacro that is known to be one of guile's built in macros. */ SCM scm_i_make_primitive_macro (const char *name, scm_t_macro_primitive fn) @@ -71,7 +73,7 @@ scm_i_make_primitive_macro (const char *name, scm_t_macro_primitive fn) SCM z = scm_words (scm_tc16_macro, 5); SCM_SET_SMOB_DATA_N (z, 1, (scm_t_bits)fn); SCM_SET_SMOB_OBJECT_N (z, 2, scm_from_utf8_symbol (name)); - SCM_SET_SMOB_OBJECT_N (z, 3, SCM_BOOL_F); + SCM_SET_SMOB_OBJECT_N (z, 3, sym_primitive_macro); SCM_SET_SMOB_OBJECT_N (z, 4, SCM_BOOL_F); return z; } diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 532e80f04..151bf8e5b 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -116,26 +116,6 @@ (session-id (let ((v (module-variable (current-module) 'syntax-session-id))) (lambda () ((variable-ref v))))) - (put-global-definition-hook - (lambda (symbol type val) - (module-define! - (current-module) - symbol - (make-syntax-transformer symbol type val)))) - (get-global-definition-hook - (lambda (symbol module) - (if (and (not module) (current-module)) - (warn "module system is booted, we should have a module" symbol)) - (and (not (equal? module '(primitive))) - (let ((v (module-variable - (if module (resolve-module (cdr module)) (current-module)) - symbol))) - (and v - (variable-bound? v) - (let ((val (variable-ref v))) - (and (macro? val) - (macro-type val) - (cons (macro-type val) (macro-binding val))))))))) (decorate-source (lambda (e s) (if (and s (supports-source-properties? e)) @@ -273,7 +253,11 @@ (cons a (macros-only-env (cdr r))) (macros-only-env (cdr r))))))) (global-extend - (lambda (type sym val) (put-global-definition-hook sym type val))) + (lambda (type sym val) + (module-define! + (current-module) + sym + (make-syntax-transformer sym type val)))) (nonsymbol-id? (lambda (x) (and (syntax? x) (symbol? (syntax-expression x))))) (id? (lambda (x) @@ -432,23 +416,37 @@ (resolve-identifier (lambda (id w r mod resolve-syntax-parameters?) (letrec* - ((resolve-syntax-parameters - (lambda (b) - (if (and resolve-syntax-parameters? (eq? (car b) 'syntax-parameter)) - (or (assq-ref r (cdr b)) (cons 'macro (car (cdr b)))) - b))) - (resolve-global + ((resolve-global (lambda (var mod) - (let ((b (resolve-syntax-parameters - (or (get-global-definition-hook var mod) '(global))))) - (if (eq? (car b) 'global) - (values 'global var mod) - (values (car b) (cdr b) mod))))) + (if (and (not mod) (current-module)) + (warn "module system is booted, we should have a module" var)) + (let ((v (and (not (equal? mod '(primitive))) + (module-variable + (if mod (resolve-module (cdr mod)) (current-module)) + var)))) + (if (and v (variable-bound? v) (macro? (variable-ref v))) + (let* ((m (variable-ref v)) + (type (macro-type m)) + (trans (macro-binding m)) + (trans (if (pair? trans) (car trans) trans))) + (if (eq? type 'syntax-parameter) + (if resolve-syntax-parameters? + (let ((lexical (assq-ref r v))) + (values 'macro (if lexical (cdr lexical) trans) mod)) + (values type v mod)) + (values type trans mod))) + (values 'global var mod))))) (resolve-lexical (lambda (label mod) - (let ((b (resolve-syntax-parameters - (or (assq-ref r label) '(displaced-lexical))))) - (values (car b) (cdr b) mod))))) + (let ((b (assq-ref r label))) + (if b + (let ((type (car b)) (value (cdr b))) + (if (eq? type 'syntax-parameter) + (if resolve-syntax-parameters? + (values 'macro value mod) + (values type label mod)) + (values type value mod))) + (values 'displaced-lexical #f #f)))))) (let ((n (id-var-name id w mod))) (cond ((syntax? n) (if (not (eq? n id)) @@ -692,11 +690,13 @@ (build-primcall #f 'make-syntax-transformer - (if (eq? type 'define-syntax-parameter-form) - (list (build-data #f name) - (build-data #f 'syntax-parameter) - (build-primcall #f 'list (list e))) - (list (build-data #f name) (build-data #f 'macro) e)))))) + (list (build-data #f name) + (build-data + #f + (if (eq? type 'define-syntax-parameter-form) + 'syntax-parameter + 'macro)) + e))))) (parse-when-list (lambda (e when-list) (let ((result (strip when-list '(())))) @@ -976,11 +976,11 @@ (source-wrap e w (cdr w) mod) x)) (else (decorate-source x s)))))) - (let* ((t-680b775fb37a463-7da transformer-environment) - (t-680b775fb37a463-7db (lambda (k) (k e r w s rib mod)))) + (let* ((t-680b775fb37a463-7b8 transformer-environment) + (t-680b775fb37a463-7b9 (lambda (k) (k e r w s rib mod)))) (with-fluid* - t-680b775fb37a463-7da - t-680b775fb37a463-7db + t-680b775fb37a463-7b8 + t-680b775fb37a463-7b9 (lambda () (rebuild-macro-output (p (source-wrap e (anti-mark w) s mod)) @@ -1038,7 +1038,7 @@ (extend-env (list label) (list (cons 'syntax-parameter - (list (eval-local-transformer (expand e trans-r w mod) mod)))) + (eval-local-transformer (expand e trans-r w mod) mod))) (cdr r))) (parse (cdr body) (cons id ids) labels var-ids vars vals bindings))) ((memv key '(begin-form)) @@ -1513,11 +1513,11 @@ s mod get-formals - (map (lambda (tmp-680b775fb37a463-acb - tmp-680b775fb37a463-aca - tmp-680b775fb37a463-ac9) - (cons tmp-680b775fb37a463-ac9 - (cons tmp-680b775fb37a463-aca tmp-680b775fb37a463-acb))) + (map (lambda (tmp-680b775fb37a463-aa9 + tmp-680b775fb37a463-aa8 + tmp-680b775fb37a463-aa7) + (cons tmp-680b775fb37a463-aa7 + (cons tmp-680b775fb37a463-aa8 tmp-680b775fb37a463-aa9))) e2* e1* args*))) @@ -1590,7 +1590,8 @@ (bindings (let ((trans-r (macros-only-env r))) (map (lambda (x) - (cons 'macro (eval-local-transformer (expand x trans-r w mod) mod))) + (cons 'syntax-parameter + (eval-local-transformer (expand x trans-r w mod) mod))) val)))) (expand-body (cons e1 e2) @@ -1814,11 +1815,11 @@ (apply (lambda (args e1 e2) (build-it '() - (map (lambda (tmp-680b775fb37a463-c98 - tmp-680b775fb37a463-c97 - tmp-680b775fb37a463-c96) - (cons tmp-680b775fb37a463-c96 - (cons tmp-680b775fb37a463-c97 tmp-680b775fb37a463-c98))) + (map (lambda (tmp-680b775fb37a463-c76 + tmp-680b775fb37a463-c75 + tmp-680b775fb37a463-c74) + (cons tmp-680b775fb37a463-c74 + (cons tmp-680b775fb37a463-c75 tmp-680b775fb37a463-c76))) e2 e1 args))) @@ -1830,11 +1831,11 @@ (apply (lambda (docstring args e1 e2) (build-it (list (cons 'documentation (syntax->datum docstring))) - (map (lambda (tmp-680b775fb37a463-cae - tmp-680b775fb37a463-cad - tmp-680b775fb37a463-cac) - (cons tmp-680b775fb37a463-cac - (cons tmp-680b775fb37a463-cad tmp-680b775fb37a463-cae))) + (map (lambda (tmp-680b775fb37a463-c8c + tmp-680b775fb37a463-c8b + tmp-680b775fb37a463-c8a) + (cons tmp-680b775fb37a463-c8a + (cons tmp-680b775fb37a463-c8b tmp-680b775fb37a463-c8c))) e2 e1 args))) @@ -1857,11 +1858,11 @@ (apply (lambda (args e1 e2) (build-it '() - (map (lambda (tmp-680b775fb37a463-cce - tmp-680b775fb37a463-ccd - tmp-680b775fb37a463-ccc) - (cons tmp-680b775fb37a463-ccc - (cons tmp-680b775fb37a463-ccd tmp-680b775fb37a463-cce))) + (map (lambda (tmp-680b775fb37a463-cac + tmp-680b775fb37a463-cab + tmp-680b775fb37a463-caa) + (cons tmp-680b775fb37a463-caa + (cons tmp-680b775fb37a463-cab tmp-680b775fb37a463-cac))) e2 e1 args))) @@ -1873,11 +1874,11 @@ (apply (lambda (docstring args e1 e2) (build-it (list (cons 'documentation (syntax->datum docstring))) - (map (lambda (tmp-680b775fb37a463-ce4 - tmp-680b775fb37a463-ce3 - tmp-680b775fb37a463-ce2) - (cons tmp-680b775fb37a463-ce2 - (cons tmp-680b775fb37a463-ce3 tmp-680b775fb37a463-ce4))) + (map (lambda (tmp-680b775fb37a463-cc2 + tmp-680b775fb37a463-cc1 + tmp-680b775fb37a463-cc0) + (cons tmp-680b775fb37a463-cc0 + (cons tmp-680b775fb37a463-cc1 tmp-680b775fb37a463-cc2))) e2 e1 args))) @@ -2452,8 +2453,7 @@ (let ((key type)) (cond ((memv key '(lexical)) (values 'lexical value)) ((memv key '(macro)) (values 'macro value)) - ((memv key '(syntax-parameter)) - (values 'syntax-parameter (car value))) + ((memv key '(syntax-parameter)) (values 'syntax-parameter value)) ((memv key '(syntax)) (values 'pattern-variable value)) ((memv key '(displaced-lexical)) (values 'displaced-lexical #f)) ((memv key '(global)) @@ -2802,9 +2802,11 @@ #f k (list docstring) - (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463) - (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1) - tmp-680b775fb37a463-2)) + (map (lambda (tmp-680b775fb37a463 + tmp-680b775fb37a463-112f + tmp-680b775fb37a463-112e) + (list (cons tmp-680b775fb37a463-112e tmp-680b775fb37a463-112f) + tmp-680b775fb37a463)) template pattern keyword))) @@ -2819,11 +2821,9 @@ dots k '() - (map (lambda (tmp-680b775fb37a463-116b - tmp-680b775fb37a463-116a - tmp-680b775fb37a463) - (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-116a) - tmp-680b775fb37a463-116b)) + (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463) + (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1) + tmp-680b775fb37a463-2)) template pattern keyword))) @@ -2839,9 +2839,9 @@ dots k (list docstring) - (map (lambda (tmp-680b775fb37a463-118a tmp-680b775fb37a463-1 tmp-680b775fb37a463) + (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463) (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1) - tmp-680b775fb37a463-118a)) + tmp-680b775fb37a463-2)) template pattern keyword))) @@ -2989,8 +2989,8 @@ (apply (lambda (p) (if (= lev 0) (quasilist* - (map (lambda (tmp-680b775fb37a463-11f5) - (list "value" tmp-680b775fb37a463-11f5)) + (map (lambda (tmp-680b775fb37a463-11d3) + (list "value" tmp-680b775fb37a463-11d3)) p) (quasi q lev)) (quasicons @@ -3013,8 +3013,8 @@ (apply (lambda (p) (if (= lev 0) (quasiappend - (map (lambda (tmp-680b775fb37a463-11fa) - (list "value" tmp-680b775fb37a463-11fa)) + (map (lambda (tmp-680b775fb37a463-11d8) + (list "value" tmp-680b775fb37a463-11d8)) p) (quasi q lev)) (quasicons @@ -3048,7 +3048,8 @@ (apply (lambda (p) (if (= lev 0) (quasilist* - (map (lambda (tmp-680b775fb37a463) (list "value" tmp-680b775fb37a463)) + (map (lambda (tmp-680b775fb37a463-11ee) + (list "value" tmp-680b775fb37a463-11ee)) p) (vquasi q lev)) (quasicons @@ -3067,8 +3068,8 @@ (apply (lambda (p) (if (= lev 0) (quasiappend - (map (lambda (tmp-680b775fb37a463) - (list "value" tmp-680b775fb37a463)) + (map (lambda (tmp-680b775fb37a463-11f3) + (list "value" tmp-680b775fb37a463-11f3)) p) (vquasi q lev)) (quasicons @@ -3158,8 +3159,8 @@ (let ((tmp-1 ls)) (let ((tmp ($sc-dispatch tmp-1 'each-any))) (if tmp - (apply (lambda (t-680b775fb37a463-125e) - (cons "vector" t-680b775fb37a463-125e)) + (apply (lambda (t-680b775fb37a463-123c) + (cons "vector" t-680b775fb37a463-123c)) tmp) (syntax-violation #f @@ -3169,8 +3170,7 @@ (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") each-any)))) (if tmp-1 (apply (lambda (y) - (k (map (lambda (tmp-680b775fb37a463-126a) - (list "quote" tmp-680b775fb37a463-126a)) + (k (map (lambda (tmp-680b775fb37a463) (list "quote" tmp-680b775fb37a463)) y))) tmp-1) (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list") . each-any)))) @@ -3213,10 +3213,10 @@ (let ((tmp-1 (list (emit (car x*)) (f (cdr x*))))) (let ((tmp ($sc-dispatch tmp-1 '(any any)))) (if tmp - (apply (lambda (t-680b775fb37a463-129c t-680b775fb37a463-129b) + (apply (lambda (t-680b775fb37a463-127a t-680b775fb37a463) (list (make-syntax 'cons '((top)) '(hygiene guile)) - t-680b775fb37a463-129c - t-680b775fb37a463-129b)) + t-680b775fb37a463-127a + t-680b775fb37a463)) tmp) (syntax-violation #f @@ -3229,9 +3229,9 @@ (let ((tmp-1 (map emit x))) (let ((tmp ($sc-dispatch tmp-1 'each-any))) (if tmp - (apply (lambda (t-680b775fb37a463-12a8) + (apply (lambda (t-680b775fb37a463) (cons (make-syntax 'append '((top)) '(hygiene guile)) - t-680b775fb37a463-12a8)) + t-680b775fb37a463)) tmp) (syntax-violation #f @@ -3244,9 +3244,9 @@ (let ((tmp-1 (map emit x))) (let ((tmp ($sc-dispatch tmp-1 'each-any))) (if tmp - (apply (lambda (t-680b775fb37a463-12b4) + (apply (lambda (t-680b775fb37a463) (cons (make-syntax 'vector '((top)) '(hygiene guile)) - t-680b775fb37a463-12b4)) + t-680b775fb37a463)) tmp) (syntax-violation #f @@ -3257,9 +3257,9 @@ (if tmp-1 (apply (lambda (x) (let ((tmp (emit x))) - (let ((t-680b775fb37a463-12c0 tmp)) + (let ((t-680b775fb37a463-129e tmp)) (list (make-syntax 'list->vector '((top)) '(hygiene guile)) - t-680b775fb37a463-12c0)))) + t-680b775fb37a463-129e)))) tmp-1) (let ((tmp-1 ($sc-dispatch tmp '(#(atom "value") any)))) (if tmp-1 diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index adc699713..0cad97769 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -1,6 +1,6 @@ ;;;; -*-scheme-*- ;;;; -;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010-2018 +;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010-2019 ;;;; Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -292,29 +292,7 @@ (define session-id (let ((v (module-variable (current-module) 'syntax-session-id))) (lambda () - ((variable-ref v))))) - - (define put-global-definition-hook - (lambda (symbol type val) - (module-define! (current-module) - symbol - (make-syntax-transformer symbol type val)))) - - (define get-global-definition-hook - (lambda (symbol module) - (if (and (not module) (current-module)) - (warn "module system is booted, we should have a module" symbol)) - (and (not (equal? module '(primitive))) - (let ((v (module-variable (if module - (resolve-module (cdr module)) - (current-module)) - symbol))) - (and v (variable-bound? v) - (let ((val (variable-ref v))) - (and (macro? val) (macro-type val) - (cons (macro-type val) - (macro-binding val)))))))))) - + ((variable-ref v)))))) (define (decorate-source e s) (if (and s (supports-source-properties? e)) @@ -492,11 +470,10 @@ ;; wrap : id --> label ;; env : label --> - ;; environments are represented in two parts: a lexical part and a global - ;; part. The lexical part is a simple list of associations from labels - ;; to bindings. The global part is implemented by - ;; {put,get}-global-definition-hook and associates symbols with - ;; bindings. + ;; environments are represented in two parts: a lexical part and a + ;; global part. The lexical part is a simple list of associations + ;; from labels to bindings. The global part is implemented by + ;; Guile's module system and associates symbols with bindings. ;; global (assumed global variable) and displaced-lexical (see below) ;; do not show up in any environment; instead, they are fabricated by @@ -507,7 +484,7 @@ ;; identifier bindings include a type and a value ;; ::= (macro . ) macros - ;; (syntax-parameter . ()) syntax parameters + ;; (syntax-parameter . ) syntax parameters ;; (core . ) core forms ;; (module-ref . ) @ or @@ ;; (begin) begin @@ -589,7 +566,9 @@ (define global-extend (lambda (type sym val) - (put-global-definition-hook sym type val))) + (module-define! (current-module) + sym + (make-syntax-transformer sym type val)))) ;; Conceptually, identifiers are always syntax objects. Internally, @@ -871,27 +850,75 @@ results))))))) (scan (wrap-subst w) '()))) - ;; Returns three values: binding type, binding value, the module (for - ;; resolving toplevel vars). + ;; Returns three values: binding type, binding value, and the module + ;; (for resolving toplevel vars). (define (resolve-identifier id w r mod resolve-syntax-parameters?) - (define (resolve-syntax-parameters b) - (if (and resolve-syntax-parameters? - (eq? (binding-type b) 'syntax-parameter)) - (or (assq-ref r (binding-value b)) - (make-binding 'macro (car (binding-value b)))) - b)) (define (resolve-global var mod) - (let ((b (resolve-syntax-parameters - (or (get-global-definition-hook var mod) - (make-binding 'global))))) - (if (eq? (binding-type b) 'global) - (values 'global var mod) - (values (binding-type b) (binding-value b) mod)))) + (when (and (not mod) (current-module)) + (warn "module system is booted, we should have a module" var)) + (let ((v (and (not (equal? mod '(primitive))) + (module-variable (if mod + (resolve-module (cdr mod)) + (current-module)) + var)))) + ;; The expander needs to know when a top-level definition from + ;; outside the compilation unit is a macro. + ;; + ;; Additionally if a macro is actually a syntax-parameter, we + ;; might need to resolve its current binding. If the syntax + ;; parameter is locally bound (via syntax-parameterize), then + ;; its variable will be present in `r', the expand-time + ;; environment. It's a kind of double lookup: first we see + ;; that a name is bound to a syntax parameter, then we look + ;; for the current binding of the syntax parameter. + ;; + ;; We use the variable (box) holding the syntax parameter + ;; definition as the key for the second lookup. We use the + ;; variable for two reasons: + ;; + ;; 1. If the syntax parameter is redefined in parallel + ;; (perhaps via a parallel module compilation), the + ;; redefinition keeps the same variable. We don't want to + ;; use a "key" that could change during a redefinition. See + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27476. + ;; + ;; 2. Using the variable instead of its (symname, modname) + ;; pair allows for syntax parameters to be renamed or + ;; aliased while preserving the syntax parameter's identity. + ;; + (if (and v (variable-bound? v) (macro? (variable-ref v))) + (let* ((m (variable-ref v)) + (type (macro-type m)) + (trans (macro-binding m)) + (trans (if (pair? trans) (car trans) trans))) + (if (eq? type 'syntax-parameter) + (if resolve-syntax-parameters? + (let ((lexical (assq-ref r v))) + ;; A resolved syntax parameter is + ;; indistinguishable from a macro. + (values 'macro + (if lexical + (binding-value lexical) + trans) + mod)) + ;; Return box as value for use in second lookup. + (values type v mod)) + (values type trans mod))) + (values 'global var mod)))) (define (resolve-lexical label mod) - (let ((b (resolve-syntax-parameters - (or (assq-ref r label) - (make-binding 'displaced-lexical))))) - (values (binding-type b) (binding-value b) mod))) + (let ((b (assq-ref r label))) + (if b + (let ((type (binding-type b)) + (value (binding-value b))) + (if (eq? type 'syntax-parameter) + (if resolve-syntax-parameters? + (values 'macro value mod) + ;; If the syntax parameter was defined within + ;; this compilation unit, use its label as its + ;; lookup key. + (values type label mod)) + (values type value mod))) + (values 'displaced-lexical #f #f)))) (let ((n (id-var-name id w mod))) (cond ((syntax? n) @@ -1224,13 +1251,12 @@ (build-primcall no-source 'make-syntax-transformer - (if (eq? type 'define-syntax-parameter-form) - (list (build-data no-source name) - (build-data no-source 'syntax-parameter) - (build-primcall no-source 'list (list e))) - (list (build-data no-source name) - (build-data no-source 'macro) - e)))))) + (list (build-data no-source name) + (build-data no-source + (if (eq? type 'define-syntax-parameter-form) + 'syntax-parameter + 'macro)) + e))))) (define parse-when-list (lambda (e when-list) @@ -1620,7 +1646,7 @@ (cdr r))) (parse (cdr body) (cons id ids) labels var-ids vars vals bindings))) ((define-syntax-parameter-form) - ;; Same as define-syntax-form, but different format of the binding. + ;; Same as define-syntax-form, different binding type though. (let ((id (wrap value w mod)) (label (gen-label)) (trans-r (macros-only-env er))) @@ -1629,9 +1655,9 @@ (list label) (list (make-binding 'syntax-parameter - (list (eval-local-transformer - (expand e trans-r w mod) - mod)))) + (eval-local-transformer + (expand e trans-r w mod) + mod))) (cdr r))) (parse (cdr body) (cons id ids) labels var-ids vars vals bindings))) ((begin-form) @@ -2032,14 +2058,14 @@ (let ((trans-r (macros-only-env r))) (map (lambda (x) (make-binding - 'macro + 'syntax-parameter (eval-local-transformer (expand x trans-r w mod) mod))) #'(val ...))))) (expand-body #'(e1 e2 ...) - (source-wrap e w s mod) - (extend-env names bindings r) - w - mod))) + (source-wrap e w s mod) + (extend-env names bindings r) + w + mod))) (_ (syntax-violation 'syntax-parameterize "bad syntax" (source-wrap e w s mod)))))) @@ -2778,7 +2804,7 @@ (case type ((lexical) (values 'lexical value)) ((macro) (values 'macro value)) - ((syntax-parameter) (values 'syntax-parameter (car value))) + ((syntax-parameter) (values 'syntax-parameter value)) ((syntax) (values 'pattern-variable value)) ((displaced-lexical) (values 'displaced-lexical #f)) ((global)