mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
psyntax: Cosmetic change to overriden globals
* module/ice-9/psyntax.scm (define/override, define*/override): Use instead of set! on globals. ($sc-dispatch): Renest. Will compile to the same thing as before. * module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Andy Wingo
parent
2395f3b74c
commit
2f175f3453
2 changed files with 260 additions and 248 deletions
|
|
@ -105,6 +105,8 @@
|
|||
(fk)))))
|
||||
(top-level-eval (lambda (x mod) (primitive-eval x)))
|
||||
(local-eval (lambda (x mod) (primitive-eval x)))
|
||||
(global-extend
|
||||
(lambda (type sym val) (module-define! (current-module) sym (make-syntax-transformer sym type val))))
|
||||
(sourcev-filename (lambda (s) (vector-ref s 0)))
|
||||
(sourcev-line (lambda (s) (vector-ref s 1)))
|
||||
(sourcev-column (lambda (s) (vector-ref s 2)))
|
||||
|
|
@ -306,8 +308,6 @@
|
|||
(fk))))
|
||||
(fk))))))
|
||||
(if (null? v) '() (fk)))))
|
||||
(global-extend
|
||||
(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) (if (symbol? x) #t (and (syntax? x) (symbol? (syntax-expression x))))))
|
||||
(id-sym-name (lambda (x) (if (syntax? x) (syntax-expression x) x)))
|
||||
|
|
@ -1196,11 +1196,11 @@
|
|||
(source-wrap e w (wrap-subst w) mod)
|
||||
x))
|
||||
(else (decorate-source x))))))
|
||||
(let* ((t-680b775fb37a463-c86 transformer-environment)
|
||||
(t-680b775fb37a463-c87 (lambda (k) (k e r w s rib mod))))
|
||||
(let* ((t-680b775fb37a463-cbb transformer-environment)
|
||||
(t-680b775fb37a463-cbc (lambda (k) (k e r w s rib mod))))
|
||||
(with-fluid*
|
||||
t-680b775fb37a463-c86
|
||||
t-680b775fb37a463-c87
|
||||
t-680b775fb37a463-cbb
|
||||
t-680b775fb37a463-cbc
|
||||
(lambda () (rebuild-macro-output (p (source-wrap e (anti-mark w) s mod)) (new-mark))))))))
|
||||
(expand-body
|
||||
(lambda (body outer-form r w mod)
|
||||
|
|
@ -1731,11 +1731,11 @@
|
|||
s
|
||||
mod
|
||||
get-formals
|
||||
(map (lambda (tmp-680b775fb37a463-f0f
|
||||
tmp-680b775fb37a463-f0e
|
||||
tmp-680b775fb37a463-f0d)
|
||||
(cons tmp-680b775fb37a463-f0d
|
||||
(cons tmp-680b775fb37a463-f0e tmp-680b775fb37a463-f0f)))
|
||||
(map (lambda (tmp-680b775fb37a463-f44
|
||||
tmp-680b775fb37a463-f43
|
||||
tmp-680b775fb37a463-f42)
|
||||
(cons tmp-680b775fb37a463-f42
|
||||
(cons tmp-680b775fb37a463-f43 tmp-680b775fb37a463-f44)))
|
||||
e2*
|
||||
e1*
|
||||
args*)))
|
||||
|
|
@ -2008,8 +2008,11 @@
|
|||
(apply (lambda (args e1 e2)
|
||||
(build-it
|
||||
'()
|
||||
(map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
|
||||
(cons tmp-680b775fb37a463 (cons tmp-680b775fb37a463-1 tmp-680b775fb37a463-2)))
|
||||
(map (lambda (tmp-680b775fb37a463-11a9
|
||||
tmp-680b775fb37a463-11a8
|
||||
tmp-680b775fb37a463-11a7)
|
||||
(cons tmp-680b775fb37a463-11a7
|
||||
(cons tmp-680b775fb37a463-11a8 tmp-680b775fb37a463-11a9)))
|
||||
e2
|
||||
e1
|
||||
args)))
|
||||
|
|
@ -2019,9 +2022,11 @@
|
|||
(apply (lambda (docstring args e1 e2)
|
||||
(build-it
|
||||
(list (cons 'documentation (syntax->datum docstring)))
|
||||
(map (lambda (tmp-680b775fb37a463-118a tmp-680b775fb37a463-1 tmp-680b775fb37a463)
|
||||
(cons tmp-680b775fb37a463
|
||||
(cons tmp-680b775fb37a463-1 tmp-680b775fb37a463-118a)))
|
||||
(map (lambda (tmp-680b775fb37a463-11bf
|
||||
tmp-680b775fb37a463-11be
|
||||
tmp-680b775fb37a463-11bd)
|
||||
(cons tmp-680b775fb37a463-11bd
|
||||
(cons tmp-680b775fb37a463-11be tmp-680b775fb37a463-11bf)))
|
||||
e2
|
||||
e1
|
||||
args)))
|
||||
|
|
@ -2039,11 +2044,11 @@
|
|||
(apply (lambda (args e1 e2)
|
||||
(build-it
|
||||
'()
|
||||
(map (lambda (tmp-680b775fb37a463-11aa
|
||||
tmp-680b775fb37a463-11a9
|
||||
tmp-680b775fb37a463-11a8)
|
||||
(cons tmp-680b775fb37a463-11a8
|
||||
(cons tmp-680b775fb37a463-11a9 tmp-680b775fb37a463-11aa)))
|
||||
(map (lambda (tmp-680b775fb37a463-11df
|
||||
tmp-680b775fb37a463-11de
|
||||
tmp-680b775fb37a463-11dd)
|
||||
(cons tmp-680b775fb37a463-11dd
|
||||
(cons tmp-680b775fb37a463-11de tmp-680b775fb37a463-11df)))
|
||||
e2
|
||||
e1
|
||||
args)))
|
||||
|
|
@ -2053,11 +2058,11 @@
|
|||
(apply (lambda (docstring args e1 e2)
|
||||
(build-it
|
||||
(list (cons 'documentation (syntax->datum docstring)))
|
||||
(map (lambda (tmp-680b775fb37a463-11c0
|
||||
tmp-680b775fb37a463-11bf
|
||||
tmp-680b775fb37a463-11be)
|
||||
(cons tmp-680b775fb37a463-11be
|
||||
(cons tmp-680b775fb37a463-11bf tmp-680b775fb37a463-11c0)))
|
||||
(map (lambda (tmp-680b775fb37a463-11f5
|
||||
tmp-680b775fb37a463-11f4
|
||||
tmp-680b775fb37a463-11f3)
|
||||
(cons tmp-680b775fb37a463-11f3
|
||||
(cons tmp-680b775fb37a463-11f4 tmp-680b775fb37a463-11f5)))
|
||||
e2
|
||||
e1
|
||||
args)))
|
||||
|
|
@ -2620,6 +2625,8 @@
|
|||
(define! '%syntax-module %syntax-module)
|
||||
(define! 'syntax-local-binding syntax-local-binding)
|
||||
(define! 'syntax-locally-bound-identifiers syntax-locally-bound-identifiers))
|
||||
(set! $sc-dispatch
|
||||
(lambda (e p)
|
||||
(letrec* ((match-each
|
||||
(lambda (e p w mod)
|
||||
(cond
|
||||
|
|
@ -2628,7 +2635,11 @@
|
|||
(and first (let ((rest (match-each (cdr e) p w mod))) (and rest (cons first rest))))))
|
||||
((null? e) '())
|
||||
((syntax? e)
|
||||
(match-each (syntax-expression e) p (join-wraps w (syntax-wrap e)) (or (syntax-module e) mod)))
|
||||
(match-each
|
||||
(syntax-expression e)
|
||||
p
|
||||
(join-wraps w (syntax-wrap e))
|
||||
(or (syntax-module e) mod)))
|
||||
(else #f))))
|
||||
(match-each+
|
||||
(lambda (e x-pat y-pat z-pat w r mod)
|
||||
|
|
@ -2688,22 +2699,29 @@
|
|||
(if (null? (car l)) r (cons (map car l) (collect (map cdr l)))))))))
|
||||
((memv key '(each+))
|
||||
(call-with-values
|
||||
(lambda () (match-each+ e (vector-ref p 1) (vector-ref p 2) (vector-ref p 3) w r mod))
|
||||
(lambda ()
|
||||
(match-each+ e (vector-ref p 1) (vector-ref p 2) (vector-ref p 3) w r mod))
|
||||
(lambda (xr* y-pat r)
|
||||
(and r (null? y-pat) (if (null? xr*) (match-empty (vector-ref p 1) r) (combine xr* r))))))
|
||||
(and r
|
||||
(null? y-pat)
|
||||
(if (null? xr*) (match-empty (vector-ref p 1) r) (combine xr* r))))))
|
||||
((memv key '(free-id)) (and (id? e) (free-id=? (wrap e w mod) (vector-ref p 1)) r))
|
||||
((memv key '(atom)) (and (equal? (vector-ref p 1) (strip e)) r))
|
||||
((memv key '(vector)) (and (vector? e) (match (vector->list e) (vector-ref p 1) w r mod)))))))))
|
||||
((memv key '(vector))
|
||||
(and (vector? e) (match (vector->list e) (vector-ref p 1) w r mod)))))))))
|
||||
(match (lambda (e p w r mod)
|
||||
(cond
|
||||
((not r) #f)
|
||||
((eq? p '_) r)
|
||||
((eq? p 'any) (cons (wrap e w mod) r))
|
||||
((syntax? e)
|
||||
(match* (syntax-expression e) p (join-wraps w (syntax-wrap e)) r (or (syntax-module e) mod)))
|
||||
(match*
|
||||
(syntax-expression e)
|
||||
p
|
||||
(join-wraps w (syntax-wrap e))
|
||||
r
|
||||
(or (syntax-module e) mod)))
|
||||
(else (match* e p w r mod))))))
|
||||
(set! $sc-dispatch
|
||||
(lambda (e p)
|
||||
(cond
|
||||
((eq? p 'any) (list e))
|
||||
((eq? p '_) '())
|
||||
|
|
@ -2867,9 +2885,9 @@
|
|||
#f
|
||||
k
|
||||
'()
|
||||
(map (lambda (tmp-680b775fb37a463-149e tmp-680b775fb37a463-149d tmp-680b775fb37a463-149c)
|
||||
(list (cons tmp-680b775fb37a463-149c tmp-680b775fb37a463-149d)
|
||||
tmp-680b775fb37a463-149e))
|
||||
(map (lambda (tmp-680b775fb37a463-14d3 tmp-680b775fb37a463-14d2 tmp-680b775fb37a463-14d1)
|
||||
(list (cons tmp-680b775fb37a463-14d1 tmp-680b775fb37a463-14d2)
|
||||
tmp-680b775fb37a463-14d3))
|
||||
template
|
||||
pattern
|
||||
keyword)))
|
||||
|
|
@ -2884,11 +2902,11 @@
|
|||
#f
|
||||
k
|
||||
(list docstring)
|
||||
(map (lambda (tmp-680b775fb37a463-14b7
|
||||
tmp-680b775fb37a463-14b6
|
||||
tmp-680b775fb37a463-14b5)
|
||||
(list (cons tmp-680b775fb37a463-14b5 tmp-680b775fb37a463-14b6)
|
||||
tmp-680b775fb37a463-14b7))
|
||||
(map (lambda (tmp-680b775fb37a463-14ec
|
||||
tmp-680b775fb37a463-14eb
|
||||
tmp-680b775fb37a463-14ea)
|
||||
(list (cons tmp-680b775fb37a463-14ea tmp-680b775fb37a463-14eb)
|
||||
tmp-680b775fb37a463-14ec))
|
||||
template
|
||||
pattern
|
||||
keyword)))
|
||||
|
|
@ -2900,11 +2918,9 @@
|
|||
dots
|
||||
k
|
||||
'()
|
||||
(map (lambda (tmp-680b775fb37a463-14d0
|
||||
tmp-680b775fb37a463-14cf
|
||||
tmp-680b775fb37a463-14ce)
|
||||
(list (cons tmp-680b775fb37a463-14ce tmp-680b775fb37a463-14cf)
|
||||
tmp-680b775fb37a463-14d0))
|
||||
(map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
|
||||
(list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)
|
||||
tmp-680b775fb37a463-2))
|
||||
template
|
||||
pattern
|
||||
keyword)))
|
||||
|
|
@ -2920,11 +2936,11 @@
|
|||
dots
|
||||
k
|
||||
(list docstring)
|
||||
(map (lambda (tmp-680b775fb37a463-14ef
|
||||
tmp-680b775fb37a463-14ee
|
||||
tmp-680b775fb37a463-14ed)
|
||||
(list (cons tmp-680b775fb37a463-14ed tmp-680b775fb37a463-14ee)
|
||||
tmp-680b775fb37a463-14ef))
|
||||
(map (lambda (tmp-680b775fb37a463-2
|
||||
tmp-680b775fb37a463-1
|
||||
tmp-680b775fb37a463)
|
||||
(list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)
|
||||
tmp-680b775fb37a463-2))
|
||||
template
|
||||
pattern
|
||||
keyword)))
|
||||
|
|
@ -3052,9 +3068,9 @@
|
|||
(apply (lambda (p)
|
||||
(if (= lev 0)
|
||||
(quasilist*
|
||||
(map (lambda (tmp-680b775fb37a463-159c)
|
||||
(map (lambda (tmp-680b775fb37a463-15d1)
|
||||
(list "value"
|
||||
tmp-680b775fb37a463-159c))
|
||||
tmp-680b775fb37a463-15d1))
|
||||
p)
|
||||
(quasi q lev))
|
||||
(quasicons
|
||||
|
|
@ -3080,9 +3096,9 @@
|
|||
(apply (lambda (p)
|
||||
(if (= lev 0)
|
||||
(quasiappend
|
||||
(map (lambda (tmp-680b775fb37a463-15a1)
|
||||
(map (lambda (tmp-680b775fb37a463-15d6)
|
||||
(list "value"
|
||||
tmp-680b775fb37a463-15a1))
|
||||
tmp-680b775fb37a463-15d6))
|
||||
p)
|
||||
(quasi q lev))
|
||||
(quasicons
|
||||
|
|
@ -3118,8 +3134,8 @@
|
|||
(apply (lambda (p)
|
||||
(if (= lev 0)
|
||||
(quasilist*
|
||||
(map (lambda (tmp-680b775fb37a463-15b7)
|
||||
(list "value" tmp-680b775fb37a463-15b7))
|
||||
(map (lambda (tmp-680b775fb37a463-15ec)
|
||||
(list "value" tmp-680b775fb37a463-15ec))
|
||||
p)
|
||||
(vquasi q lev))
|
||||
(quasicons
|
||||
|
|
@ -3139,8 +3155,8 @@
|
|||
(apply (lambda (p)
|
||||
(if (= lev 0)
|
||||
(quasiappend
|
||||
(map (lambda (tmp-680b775fb37a463-15bc)
|
||||
(list "value" tmp-680b775fb37a463-15bc))
|
||||
(map (lambda (tmp-680b775fb37a463-15f1)
|
||||
(list "value" tmp-680b775fb37a463-15f1))
|
||||
p)
|
||||
(vquasi q lev))
|
||||
(quasicons
|
||||
|
|
@ -3222,7 +3238,8 @@
|
|||
(let ((tmp-1 ls))
|
||||
(let ((tmp ($sc-dispatch tmp-1 'each-any)))
|
||||
(if tmp
|
||||
(apply (lambda (t-680b775fb37a463) (cons "vector" t-680b775fb37a463))
|
||||
(apply (lambda (t-680b775fb37a463-163a)
|
||||
(cons "vector" t-680b775fb37a463-163a))
|
||||
tmp)
|
||||
(syntax-violation
|
||||
#f
|
||||
|
|
@ -3256,9 +3273,9 @@
|
|||
(let ((tmp-1 (map emit x)))
|
||||
(let ((tmp ($sc-dispatch tmp-1 'each-any)))
|
||||
(if tmp
|
||||
(apply (lambda (t-680b775fb37a463-162f)
|
||||
(apply (lambda (t-680b775fb37a463)
|
||||
(cons (make-syntax 'list '((top)) '(hygiene guile))
|
||||
t-680b775fb37a463-162f))
|
||||
t-680b775fb37a463))
|
||||
tmp)
|
||||
(syntax-violation
|
||||
#f
|
||||
|
|
@ -3293,12 +3310,12 @@
|
|||
(let ((tmp-1 (map emit x)))
|
||||
(let ((tmp ($sc-dispatch tmp-1 'each-any)))
|
||||
(if tmp
|
||||
(apply (lambda (t-680b775fb37a463-164f)
|
||||
(apply (lambda (t-680b775fb37a463)
|
||||
(cons (make-syntax
|
||||
'append
|
||||
'((top))
|
||||
'(hygiene guile))
|
||||
t-680b775fb37a463-164f))
|
||||
t-680b775fb37a463))
|
||||
tmp)
|
||||
(syntax-violation
|
||||
#f
|
||||
|
|
@ -3311,12 +3328,12 @@
|
|||
(let ((tmp-1 (map emit x)))
|
||||
(let ((tmp ($sc-dispatch tmp-1 'each-any)))
|
||||
(if tmp
|
||||
(apply (lambda (t-680b775fb37a463-165b)
|
||||
(apply (lambda (t-680b775fb37a463)
|
||||
(cons (make-syntax
|
||||
'vector
|
||||
'((top))
|
||||
'(hygiene guile))
|
||||
t-680b775fb37a463-165b))
|
||||
t-680b775fb37a463))
|
||||
tmp)
|
||||
(syntax-violation
|
||||
#f
|
||||
|
|
@ -3327,12 +3344,12 @@
|
|||
(if tmp-1
|
||||
(apply (lambda (x)
|
||||
(let ((tmp (emit x)))
|
||||
(let ((t-680b775fb37a463 tmp))
|
||||
(let ((t-680b775fb37a463-169c tmp))
|
||||
(list (make-syntax
|
||||
'list->vector
|
||||
'((top))
|
||||
'(hygiene guile))
|
||||
t-680b775fb37a463))))
|
||||
t-680b775fb37a463-169c))))
|
||||
tmp-1)
|
||||
(let ((tmp-1 ($sc-dispatch tmp '(#(atom "value") any))))
|
||||
(if tmp-1
|
||||
|
|
|
|||
|
|
@ -2588,6 +2588,14 @@
|
|||
(global-extend 'eval-when 'eval-when '())
|
||||
(global-extend 'core 'syntax-case expand-syntax-case)
|
||||
|
||||
(define-syntax define/override
|
||||
(syntax-rules ()
|
||||
((_ (id . args) . body) (define/override id (lambda args . body)))
|
||||
((_ id exp) (set! id exp))))
|
||||
(define-syntax define*/override
|
||||
(syntax-rules ()
|
||||
((_ (id . args) . body) (define/override id (lambda* args . body)))))
|
||||
|
||||
;; The portable macroexpand seeds expand-top's mode m with 'e (for
|
||||
;; evaluating) and esew (which stands for "eval syntax expanders
|
||||
;; when") with '(eval). In Chez Scheme, m is set to 'c instead of e
|
||||
|
|
@ -2597,8 +2605,7 @@
|
|||
;; syntactic definitions are evaluated immediately after they are
|
||||
;; expanded, and the expanded definitions are also residualized into
|
||||
;; the object file if we are compiling a file.
|
||||
(set! macroexpand
|
||||
(lambda* (x #:optional (m 'e) (esew '(eval)))
|
||||
(define*/override (macroexpand x #:optional (m 'e) (esew '(eval)))
|
||||
(define (unstrip x)
|
||||
(define (annotate result)
|
||||
(let ((props (source-properties x)))
|
||||
|
|
@ -2614,14 +2621,12 @@
|
|||
((syntax? x) x)
|
||||
(else (annotate x))))
|
||||
(expand-top-sequence (list (unstrip x)) null-env top-wrap #f m esew
|
||||
(cons 'hygiene (module-name (current-module))))))
|
||||
(cons 'hygiene (module-name (current-module)))))
|
||||
|
||||
(set! identifier?
|
||||
(lambda (x)
|
||||
(nonsymbol-id? x)))
|
||||
(define/override (identifier? x)
|
||||
(nonsymbol-id? x))
|
||||
|
||||
(set! datum->syntax
|
||||
(lambda* (id datum #:key source)
|
||||
(define*/override (datum->syntax id datum #:key source)
|
||||
(define (props->sourcev alist)
|
||||
(and (pair? alist)
|
||||
(vector (assq-ref alist 'filename)
|
||||
|
|
@ -2641,36 +2646,31 @@
|
|||
(props->sourcev source))
|
||||
((and (vector? source) (= 3 (vector-length source)))
|
||||
source)
|
||||
(else (syntax-sourcev source))))))
|
||||
(else (syntax-sourcev source)))))
|
||||
|
||||
(set! syntax->datum
|
||||
(define/override (syntax->datum x)
|
||||
;; accepts any object, since syntax objects may consist partially
|
||||
;; or entirely of unwrapped, nonsymbolic data
|
||||
(lambda (x)
|
||||
(strip x)))
|
||||
(strip x))
|
||||
|
||||
(set! generate-temporaries
|
||||
(lambda (ls)
|
||||
(define/override (generate-temporaries ls)
|
||||
(arg-check list? ls 'generate-temporaries)
|
||||
(let ((mod (cons 'hygiene (module-name (current-module)))))
|
||||
(map (lambda (x)
|
||||
(wrap (gen-var 't) top-wrap mod))
|
||||
ls))))
|
||||
ls)))
|
||||
|
||||
(set! free-identifier=?
|
||||
(lambda (x y)
|
||||
(define/override (free-identifier=? x y)
|
||||
(arg-check nonsymbol-id? x 'free-identifier=?)
|
||||
(arg-check nonsymbol-id? y 'free-identifier=?)
|
||||
(free-id=? x y)))
|
||||
(free-id=? x y))
|
||||
|
||||
(set! bound-identifier=?
|
||||
(lambda (x y)
|
||||
(define/override (bound-identifier=? x y)
|
||||
(arg-check nonsymbol-id? x 'bound-identifier=?)
|
||||
(arg-check nonsymbol-id? y 'bound-identifier=?)
|
||||
(bound-id=? x y)))
|
||||
(bound-id=? x y))
|
||||
|
||||
(set! syntax-violation
|
||||
(lambda* (who message form #:optional subform)
|
||||
(define*/override (syntax-violation who message form #:optional subform)
|
||||
(arg-check (lambda (x) (or (not x) (string? x) (symbol? x)))
|
||||
who 'syntax-violation)
|
||||
(arg-check string? message 'syntax-violation)
|
||||
|
|
@ -2679,7 +2679,7 @@
|
|||
(or (source-annotation subform)
|
||||
(source-annotation form)))
|
||||
(strip form)
|
||||
(strip subform))))
|
||||
(strip subform)))
|
||||
|
||||
(let ()
|
||||
(define (%syntax-module id)
|
||||
|
|
@ -2737,11 +2737,10 @@
|
|||
(define! 'syntax-local-binding syntax-local-binding)
|
||||
(define! 'syntax-locally-bound-identifiers syntax-locally-bound-identifiers))
|
||||
|
||||
(define/override ($sc-dispatch e p)
|
||||
;; $sc-dispatch expects an expression and a pattern. If the expression
|
||||
;; matches the pattern a list of the matching expressions for each
|
||||
;; "any" is returned. Otherwise, #f is returned. (This use of #f will
|
||||
;; not work on r4rs implementations that violate the ieee requirement
|
||||
;; that #f and () be distinct.)
|
||||
;; "any" is returned. Otherwise, #f is returned.
|
||||
|
||||
;; The expression is matched with the pattern as follows:
|
||||
|
||||
|
|
@ -2760,8 +2759,6 @@
|
|||
;; not, should convert to:
|
||||
;; #(vector <pattern>*) #(<pattern>*)
|
||||
|
||||
(let ()
|
||||
|
||||
(define (match-each e p w mod)
|
||||
(cond
|
||||
((pair? e)
|
||||
|
|
@ -2884,15 +2881,13 @@
|
|||
(or (syntax-module e) mod)))
|
||||
(else (match* e p w r mod))))
|
||||
|
||||
(set! $sc-dispatch
|
||||
(lambda (e p)
|
||||
(cond
|
||||
((eq? p 'any) (list e))
|
||||
((eq? p '_) '())
|
||||
((syntax? e)
|
||||
(match* (syntax-expression e)
|
||||
p (syntax-wrap e) '() (syntax-module e)))
|
||||
(else (match* e p empty-wrap '() #f)))))))
|
||||
(else (match* e p empty-wrap '() #f)))))
|
||||
|
||||
|
||||
(define-syntax with-syntax
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue