Macro stepper:
simplified match patterns, eliminated old dollar-sign patterns added derivs to reductions; prep for jump-to and zoom-in changed step-note to step-type svn: r5316
This commit is contained in:
Ryan Culpepper
parent
26a4bca1b6
commit
9330d96ad7
|
|
@ -7,9 +7,6 @@
|
|||
AnyQ
|
||||
IntQ
|
||||
|
||||
$$
|
||||
$$I
|
||||
$$E
|
||||
Wrap
|
||||
lift/wrap
|
||||
rewrap
|
||||
|
|
@ -48,74 +45,54 @@
|
|||
(define-match-expander AnyQ
|
||||
(syntax-rules ()
|
||||
[(AnyQ S (var ...))
|
||||
(or (struct S (var ...))
|
||||
(struct interrupted-wrap (_ (struct S (var ...))))
|
||||
(struct error-wrap (_ _ (struct S (var ...)))))]
|
||||
(app unwrap (struct S (var ...)))]
|
||||
[(AnyQ S (var ...) exni)
|
||||
(or (and (struct S (var ...))
|
||||
(app (lambda (_) #f) exni))
|
||||
(and (struct interrupted-wrap (tag (struct S (var ...))))
|
||||
(app (lambda (ew) (cons #f (interrupted-wrap-tag ew))) exni))
|
||||
(and (struct error-wrap (exn tag (struct S (var ...))))
|
||||
(app (lambda (ew) (cons (error-wrap-exn ew) (error-wrap-tag ew))) exni)))]))
|
||||
|
||||
(and (app unwrap (struct S (var ...)))
|
||||
(app extract-exni exni))]))
|
||||
|
||||
;; IntQ
|
||||
;; Matches interrupted wraps and unwrapped structs
|
||||
(define-match-expander IntQ
|
||||
(syntax-rules ()
|
||||
[(IntQ S (var ...))
|
||||
(or (struct S (var ...))
|
||||
(struct interrupted-wrap (_ (struct S (var ...)))))]
|
||||
(? not-error-wrap? (app unwrap (struct S (var ...))))]
|
||||
[(IntQ S (var ...) tag)
|
||||
(or (and (struct S (var ...))
|
||||
(app (lambda (_) #f) tag))
|
||||
(struct interrupted-wrap (tag (struct S (var ...)))))]))
|
||||
|
||||
;; $$ match form
|
||||
;; ($$ struct-name (var ...) info)
|
||||
;; If normal instance of struct-name, binds info to #f
|
||||
;; If interrupted-wrapped, binds info to (cons #f symbol/#f)
|
||||
;; If error-wrapped, binds info to (cons exn symbol/#f)
|
||||
(define-match-expander $$
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[($$ S (var ...) info)
|
||||
#'(or (and (struct S (var ...))
|
||||
(app (lambda (_) #f) info))
|
||||
(and (struct interrupted-wrap (tag (struct S (var ...))))
|
||||
(app (lambda (ew) (cons #f (interrupted-wrap-tag ew))) info))
|
||||
(and (struct error-wrap (exn tag (struct S (var ...))))
|
||||
(app (lambda (ew) (cons (error-wrap-exn ew) (error-wrap-tag ew)))
|
||||
info)))]
|
||||
[($$ S (var ...))
|
||||
#'(struct S (var ...))])))
|
||||
|
||||
(define-match-expander $$I
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[($$I S (var ...))
|
||||
#'(or (struct interrupted-wrap (tag (struct S (var ...))))
|
||||
(struct S (var ...)))]
|
||||
[($$I S (var ...) tag)
|
||||
#'(or (struct interrupted-wrap (tag (struct S (var ...))))
|
||||
(and (app (lambda (_) #f) tag)
|
||||
(struct S (var ...))))])))
|
||||
|
||||
(define-match-expander $$E
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[($$E S (var ...))
|
||||
#'(or (struct interrupted-wrap (_tag (struct S (var ...))))
|
||||
(struct error-wrap (_exn _tag (struct S (var ...))))
|
||||
(struct S (var ...)))])))
|
||||
(? not-error-wrap?
|
||||
(app unwrap (struct S (var ...)))
|
||||
(app extract-tag tag))]))
|
||||
|
||||
(define-match-expander Wrap
|
||||
(syntax-rules ()
|
||||
[(Wrap x)
|
||||
(or (struct interrupted-wrap (_tag x))
|
||||
(struct error-wrap (_exn _tag x))
|
||||
x)]))
|
||||
(app unwrap x)]))
|
||||
|
||||
(define (unwrap x)
|
||||
(match x
|
||||
[(struct interrupted-wrap (tag inner))
|
||||
inner]
|
||||
[(struct error-wrap (exn tag inner))
|
||||
inner]
|
||||
[else x]))
|
||||
|
||||
(define (extract-exni x)
|
||||
(match x
|
||||
[(struct interrupted-wrap (tag inner))
|
||||
(cons #f tag)]
|
||||
[(struct error-wrap (exn tag inner))
|
||||
(cons exn tag)]
|
||||
[else #f]))
|
||||
|
||||
(define (extract-tag x)
|
||||
(match x
|
||||
[(struct interrupted-wrap (tag inner))
|
||||
tag]
|
||||
[(struct error-wrap (exn tag inner))
|
||||
tag]
|
||||
[else #f]))
|
||||
|
||||
(define (not-error-wrap? x)
|
||||
(not (error-wrap? x)))
|
||||
|
||||
;; lift/wrap : ('a -> 'b) boolean -> Wrap('a) -> Wrap('b)
|
||||
(define (lift/wrap f preserve-tag?)
|
||||
(lambda (x)
|
||||
|
|
@ -156,16 +133,6 @@
|
|||
(or (interrupted-wrap? x)
|
||||
(error-wrap? x)))
|
||||
|
||||
; (define-match-expander $$E
|
||||
; (lambda (stx)
|
||||
; (syntax-case stx (@)
|
||||
; [($$E S (var ...))
|
||||
; #'($$ S (var ...) _exni)]
|
||||
; [($$E S (var ...) @ tag)
|
||||
; #'($$ S (var ...) (cons #f tag))]
|
||||
; [($$E S (var ...) @ tag exn)
|
||||
; #'($$ S (var ...) (cons exn tag))])))
|
||||
|
||||
;; Utilities for finding subderivations
|
||||
|
||||
;; find-derivs : (deriv -> boolean) (deriv -> boolean) deriv -> (list-of deriv)
|
||||
|
|
|
|||
|
|
@ -852,14 +852,9 @@
|
|||
;; show-mrule? : MRule -> boolean
|
||||
(define (show-transformation? tx)
|
||||
(match tx
|
||||
[($$ transformation (e1 e2 rs me1 me2 locals))
|
||||
(let ([rs (reverse rs)])
|
||||
(and (pair? rs) (show-macro? (car rs))))]
|
||||
[($$ interrupted-wrap (tag inner))
|
||||
(show-transformation? inner)]
|
||||
[($$ error-wrap (exn tag inner))
|
||||
(show-transformation? inner)]))
|
||||
|
||||
[(AnyQ transformation (e1 e2 rs me1 me2 locals))
|
||||
(ormap show-macro? rs)]))
|
||||
|
||||
(define (map/2values f items)
|
||||
(if (null? items)
|
||||
(values null null)
|
||||
|
|
@ -983,7 +978,7 @@
|
|||
(decompose-letrec letrec-deriv)])]
|
||||
[(list)
|
||||
(match pass2
|
||||
[($$ lderiv (_ _ derivs) _)
|
||||
[(AnyQ lderiv (_ _ derivs))
|
||||
(values null null derivs)]
|
||||
[#f
|
||||
(values null null null)])])]
|
||||
|
|
|
|||
|
|
@ -7,14 +7,17 @@
|
|||
(all-from "steps.ss"))
|
||||
|
||||
;; A Context is (syntax -> syntax)
|
||||
;; A BigContext is (list-of (cons Syntaxes Syntax))
|
||||
;; local expansion contexts: pairs of foci, term
|
||||
;; A BigContext is (list-of (cons Derivation (cons Syntaxes Syntax)))
|
||||
;; local expansion contexts: deriv, foci, term
|
||||
|
||||
;; context: parameter of Context
|
||||
(define context (make-parameter (lambda (x) x)))
|
||||
|
||||
;; big-context: parameter of BigContext
|
||||
(define big-context (make-parameter null))
|
||||
|
||||
;; current-derivation : parameter of Derivation
|
||||
(define current-derivation (make-parameter #f))
|
||||
|
||||
(define-syntax with-context
|
||||
(syntax-rules ()
|
||||
|
|
@ -22,11 +25,18 @@
|
|||
(let ([E (context)])
|
||||
(parameterize ([context (lambda (x) (E (f x)))])
|
||||
. body))]))
|
||||
|
||||
(define-syntax with-derivation
|
||||
(syntax-rules ()
|
||||
[(with-derivation d . body)
|
||||
(parameterize ((current-derivation d)) . body)]))
|
||||
|
||||
(define-syntax with-new-local-context
|
||||
(syntax-rules ()
|
||||
[(with-new-local-context e . body)
|
||||
(parameterize ([big-context (cons (cons (list e) (E e)) (big-context))]
|
||||
(parameterize ([big-context
|
||||
(cons (cons (current-derivation) (cons (list e) (E e)))
|
||||
(big-context))]
|
||||
[context (lambda (x) x)])
|
||||
. body)]))
|
||||
|
||||
|
|
@ -79,9 +89,9 @@
|
|||
#'(let-values ([(form2-var foci1-var foci2-var description-var)
|
||||
(with-syntax ([p f])
|
||||
(values form2 foci1 foci2 description))])
|
||||
(cons (walk-rename/foci/E foci1-var foci2-var
|
||||
f form2-var
|
||||
description-var)
|
||||
(cons (walk/foci/E foci1-var foci2-var
|
||||
f form2-var
|
||||
description-var)
|
||||
(R** form2-var p . more)))]
|
||||
[(R** f p [#:walk form2 description] . more)
|
||||
#'(let-values ([(form2-var description-var)
|
||||
|
|
@ -106,7 +116,7 @@
|
|||
;; If this is the key, then insert the misstep here and stop.
|
||||
;; This stops processing *within* an error-wrapped prim.
|
||||
(if (or (eq? key #f) (eq? key (cdr info)))
|
||||
(list (make-misstep f (E f) (car info)))
|
||||
(list (stumble f (car info)))
|
||||
(continue))]
|
||||
[else
|
||||
(continue)]))]
|
||||
|
|
@ -115,16 +125,6 @@
|
|||
#'(let-values ([(reducer get-e1 get-e2) Generator])
|
||||
(R** f p [reducer get-e1 get-e2 hole0 fill0] . more))]
|
||||
|
||||
; ;; Expression case
|
||||
; [(R** f p [hole0 fill0] . more)
|
||||
; #'(R** f p [reductions deriv-e1 deriv-e2 hole0 fill0] . more)]
|
||||
; ;; List case
|
||||
; [(R** f p [List hole0 fill0] . more)
|
||||
; #'(R** f p [list-reductions lderiv-es1 lderiv-es2 hole0 fill0] . more)]
|
||||
; ;; Block case
|
||||
; [(R** f p [Block hole0 fill0] . more)
|
||||
; #'(R** f p [block-reductions bderiv-es1 bderiv-es2 hole0 fill0] . more)]
|
||||
|
||||
;; Implementation for (hole ...) sequences
|
||||
[(R** form-var pattern
|
||||
[f0 get-e1 get-e2 (hole0 :::) fill0s] . more)
|
||||
|
|
@ -168,33 +168,34 @@
|
|||
|
||||
;; -----------------------------------
|
||||
|
||||
;; walk : syntax(s) syntax(s) [string] -> Reduction
|
||||
;; walk : syntax(s) syntax(s) StepType -> Reduction
|
||||
;; Lifts a local step into a term step.
|
||||
(define walk
|
||||
(case-lambda
|
||||
[(e1 e2) (walk e1 e2 #f)]
|
||||
[(e1 e2 note) (make-rewrite-step e1 e2 (E e1) (E e2) note (big-context))]))
|
||||
(define (walk e1 e2 type)
|
||||
(make-step (current-derivation) (big-context) type
|
||||
e1 e2 (E e1) (E e2)))
|
||||
|
||||
;; walk/foci/E : syntax(s) syntax(s) syntax syntax StepType -> Reduction
|
||||
(define (walk/foci/E focus1 focus2 e1 e2 type)
|
||||
(walk/foci focus1 focus2 (E e1) (E e2) type))
|
||||
|
||||
;; walk/foci : syntax(s) syntax(s) syntax syntax StepType -> Reduction
|
||||
(define (walk/foci focus1 focus2 Ee1 Ee2 type)
|
||||
(make-step (current-derivation) (big-context) type
|
||||
focus1 focus2 Ee1 Ee2))
|
||||
|
||||
;; walk/foci/E : syntax(s) syntax(s) syntax syntax string -> Reduction
|
||||
(define (walk/foci/E focus1 focus2 e1 e2 note)
|
||||
(walk/foci focus1 focus2 (E e1) (E e2) note))
|
||||
|
||||
;; walk-rename/foci/E : syntax(s) syntax(s) syntax syntax string -> Reduction
|
||||
(define (walk-rename/foci/E focus1 focus2 e1 e2 note)
|
||||
(make-rename-step focus1 focus2 (E e1) (E e2) note (big-context)))
|
||||
|
||||
;; walk/foci : syntax(s) syntax(s) syntax syntax string -> Reduction
|
||||
(define (walk/foci focus1 focus2 Ee1 Ee2 note)
|
||||
(make-rewrite-step focus1 focus2 Ee1 Ee2 note (big-context)))
|
||||
|
||||
;; stumble : syntax exception -> Reduction
|
||||
(define (stumble stx exn)
|
||||
(make-misstep stx (E stx) exn))
|
||||
(make-misstep (current-derivation) (big-context) 'error
|
||||
stx (E stx) exn))
|
||||
|
||||
;; stumble/E : syntax(s) syntax exn -> Reduction
|
||||
(define (stumble/E focus Ee1 exn)
|
||||
(make-misstep (current-derivation) (big-context) 'error
|
||||
focus Ee1 exn))
|
||||
|
||||
;; ------------------------------------
|
||||
|
||||
(define (revappend a b)
|
||||
(cond [(pair? a) (revappend (cdr a) (cons (car a) b))]
|
||||
[(null? a) b]))
|
||||
|
||||
|
||||
)
|
||||
|
|
@ -21,22 +21,31 @@
|
|||
(syntax-id-rules ()
|
||||
[Block (values block-reductions bderiv-es1 bderiv-es2)]))
|
||||
|
||||
;; Syntax
|
||||
|
||||
(define-syntax match/with-derivation
|
||||
(syntax-rules ()
|
||||
[(match/with-derivation d . clauses)
|
||||
(let ([dvar d])
|
||||
(with-derivation dvar
|
||||
(match dvar . clauses)))]))
|
||||
|
||||
;; Reductions
|
||||
|
||||
;; reductions : Derivation -> ReductionSequence
|
||||
(define (reductions d)
|
||||
(match d
|
||||
(match/with-derivation d
|
||||
|
||||
;; Primitives
|
||||
[(struct p:variable (e1 e2 rs))
|
||||
(if (bound-identifier=? e1 e2)
|
||||
null
|
||||
(list (walk e1 e2 "Resolve variable (remove extra marks)")))]
|
||||
(list (walk e1 e2 'resolve-variable)))]
|
||||
[(IntQ p:module (e1 e2 rs #f body))
|
||||
(with-syntax ([(?module name language . BODY) e1])
|
||||
(let ([ctx (lambda (x) (d->so e1 `(,#'?module ,#'name ,#'language ,x)))]
|
||||
[body-e1 (match body [($$ deriv (body-e1 _) _) body-e1])])
|
||||
(cons (walk e1 (ctx body-e1) "Tag #%module-begin")
|
||||
[body-e1 (match body [(AnyQ deriv (body-e1 _)) body-e1])])
|
||||
(cons (walk e1 (ctx body-e1) 'tag-module-begin)
|
||||
(with-context ctx
|
||||
(reductions body)))))]
|
||||
[(IntQ p:module (e1 e2 rs #t body))
|
||||
|
|
@ -106,7 +115,7 @@
|
|||
[List LDERIV lderiv])])
|
||||
(if (eq? tagged-stx e1)
|
||||
tail
|
||||
(cons (walk e1 tagged-stx "Tag application") tail)))]
|
||||
(cons (walk e1 tagged-stx 'tag-app) tail)))]
|
||||
[(AnyQ p:lambda (e1 e2 rs renames body) exni)
|
||||
(R e1 _
|
||||
[! exni]
|
||||
|
|
@ -114,7 +123,7 @@
|
|||
[#:pattern (?lambda ?formals . ?body)]
|
||||
[#:rename (syntax/skeleton e1 (?lambda ?formals* . ?body*))
|
||||
#'?formals #'?formals*
|
||||
"Rename formal parameters"]
|
||||
'rename-lambda]
|
||||
[Block ?body body])]
|
||||
[(struct p:case-lambda (e1 e2 rs renames+bodies))
|
||||
#;
|
||||
|
|
@ -126,14 +135,14 @@
|
|||
(syntax/skeleton e1 (?case-lambda [?formals* . ?body*] ...))
|
||||
(syntax->list #'(?formals ...))
|
||||
(syntax->list #'(?formals* ...))
|
||||
"Rename formal parameters"]
|
||||
'rename-case-lambda]
|
||||
[Block (?body ...) (map cdr renames+bodies)])
|
||||
(with-syntax ([(?case-lambda [?formals . ?body] ...) e1]
|
||||
[((?formals* . ?body*) ...) (map car renames+bodies)])
|
||||
(let ([mid (syntax/skeleton e1 (?case-lambda [?formals* . ?body*] ...))])
|
||||
(cons (walk/foci/E (syntax->list #'(?formals ...))
|
||||
(syntax->list #'(?formals* ...))
|
||||
e1 mid "Rename formal parameters")
|
||||
e1 mid 'rename-case-lambda)
|
||||
(R mid (CASE-LAMBDA [FORMALS . BODY] ...)
|
||||
[Block (BODY ...) (map cdr renames+bodies)]))))]
|
||||
[(AnyQ p:let-values (e1 e2 rs renames rhss body) exni)
|
||||
|
|
@ -145,7 +154,7 @@
|
|||
(syntax/skeleton e1 (?let-values ([?vars* ?rhs*] ...) . ?body*))
|
||||
(syntax->list #'(?vars ...))
|
||||
(syntax->list #'(?vars* ...))
|
||||
"Rename bound variables"]
|
||||
'rename-let-values]
|
||||
[Expr (?rhs ...) rhss]
|
||||
[Block ?body body])]
|
||||
[(AnyQ p:letrec-values (e1 e2 rs renames rhss body) exni)
|
||||
|
|
@ -157,7 +166,7 @@
|
|||
(syntax/skeleton e1 (?letrec-values ([?vars* ?rhs*] ...) . ?body*))
|
||||
(syntax->list #'(?vars ...))
|
||||
(syntax->list #'(?vars* ...))
|
||||
"Rename bound variables"]
|
||||
'rename-letrec-values]
|
||||
[Expr (?rhs ...) rhss]
|
||||
[Block ?body body])]
|
||||
[(AnyQ p:letrec-syntaxes+values
|
||||
|
|
@ -172,34 +181,34 @@
|
|||
. ?body*))
|
||||
(syntax->list #'(?svars ...))
|
||||
(syntax->list #'(?svars* ...))
|
||||
"Rename bound variables"]
|
||||
'rename-lsv]
|
||||
[Expr (?srhs ...) srhss]
|
||||
;; If vrenames is #f, no var bindings to rename
|
||||
[#:if vrenames
|
||||
[#:bind (([?vvars** ?vrhs**] ...) . ?body**) vrenames]
|
||||
[#:rename
|
||||
(syntax/skeleton e1 (?lsv ([?svars* ?srhs*] ...)
|
||||
([?vars** ?vrhs**] ...)
|
||||
([?vvars** ?vrhs**] ...)
|
||||
. ?body**))
|
||||
(syntax->list #'(?vvars* ...))
|
||||
(syntax->list #'(?vvars** ...))
|
||||
"Rename bound variables"]]
|
||||
'rename-lsv]]
|
||||
[Expr (?vrhs ...) vrhss]
|
||||
[Block ?body body]
|
||||
=> (lambda (mid)
|
||||
(list (walk mid e2 "Remove syntax bindings"))))]
|
||||
(list (walk mid e2 'lsv-remove-syntax))))]
|
||||
;; The auto-tagged atomic primitives
|
||||
[(AnyQ p:#%datum (e1 e2 rs tagged-stx) exni)
|
||||
(append (if (eq? e1 tagged-stx)
|
||||
null
|
||||
(list (walk e1 tagged-stx "Tag datum")))
|
||||
(list (walk e1 tagged-stx 'tag-datum)))
|
||||
(if exni
|
||||
(list (stumble tagged-stx (car exni)))
|
||||
null))]
|
||||
[(AnyQ p:#%top (e1 e2 rs tagged-stx) exni)
|
||||
(append (if (eq? e1 tagged-stx)
|
||||
null
|
||||
(list (walk e1 tagged-stx "Tag top-level variable")))
|
||||
(list (walk e1 tagged-stx 'tag-top)))
|
||||
(if exni
|
||||
(list (stumble tagged-stx (car exni)))
|
||||
null))]
|
||||
|
|
@ -262,7 +271,7 @@
|
|||
|
||||
[(IntQ lift-deriv (e1 e2 first lifted-stx second))
|
||||
(append (reductions first)
|
||||
(list (walk (deriv-e2 first) lifted-stx "Capture lifts"))
|
||||
(list (walk (deriv-e2 first) lifted-stx 'capture-lifts))
|
||||
(reductions second))]
|
||||
|
||||
;; Skipped
|
||||
|
|
@ -277,7 +286,7 @@
|
|||
(match tx
|
||||
[(struct transformation (e1 e2 rs me1 me2 locals))
|
||||
(append (reductions-locals e1 locals)
|
||||
(list (walk e1 e2 "Macro transformation")))]
|
||||
(list (walk e1 e2 'macro-step)))]
|
||||
[(IntW transformation (e1 e2 rs me1 me2 locals) 'locals)
|
||||
(reductions-locals e1 locals)]
|
||||
[(ErrW transformation (e1 e2 rs me1 me2 locals) 'bad-transformer exn)
|
||||
|
|
@ -293,19 +302,19 @@
|
|||
|
||||
;; reductions-local : LocalAction -> ReductionSequence
|
||||
(define (reductions-local local)
|
||||
(match local
|
||||
(match/with-derivation local
|
||||
[(struct local-expansion (e1 e2 me1 me2 deriv))
|
||||
(reductions deriv)]
|
||||
[(struct local-lift (expr id))
|
||||
(list (walk expr id "Macro lifted expression to top-level"))]
|
||||
(list (walk expr id 'local-lift))]
|
||||
[(struct local-lift-end (decl))
|
||||
(list (walk decl decl "Declaration lifted to end of module"))]
|
||||
(list (walk decl decl 'module-lift))]
|
||||
[(struct local-bind (deriv))
|
||||
(reductions deriv)]))
|
||||
|
||||
;; list-reductions : ListDerivation -> ReductionSequence
|
||||
(define (list-reductions ld)
|
||||
(match ld
|
||||
(match/with-derivation ld
|
||||
[(IntQ lderiv (es1 es2 derivs))
|
||||
(let loop ([derivs derivs] [suffix es1])
|
||||
(cond [(pair? derivs)
|
||||
|
|
@ -323,7 +332,7 @@
|
|||
|
||||
;; block-reductions : BlockDerivation -> ReductionSequence
|
||||
(define (block-reductions bd)
|
||||
(match bd
|
||||
(match/with-derivation bd
|
||||
;; If interrupted in pass1, skip pass2
|
||||
[(IntW bderiv (es1 es2 pass1 trans pass2) 'pass1)
|
||||
(let-values ([(reductions stxs) (brules-reductions pass1 es1)])
|
||||
|
|
@ -334,8 +343,8 @@
|
|||
(append reductions1
|
||||
(if (eq? trans 'letrec)
|
||||
(match pass2
|
||||
[($$ lderiv (pass2-es1 _ _) _exni)
|
||||
(list (walk stxs1 pass2-es1 "Transform block to letrec"))])
|
||||
[(AnyQ lderiv (pass2-es1 _ _))
|
||||
(list (walk stxs1 pass2-es1 'block->letrec))])
|
||||
null)
|
||||
(list-reductions pass2)))]
|
||||
[#f null]))
|
||||
|
|
@ -343,61 +352,63 @@
|
|||
;; brules-reductions : (list-of-BRule) syntax-list -> ReductionSequence syntax-list
|
||||
(define (brules-reductions brules all-stxs)
|
||||
(let loop ([brules brules] [suffix all-stxs] [prefix null] [rss null])
|
||||
(match brules
|
||||
[(cons (struct b:expr (renames head)) next)
|
||||
(let ([estx (deriv-e2 head)])
|
||||
(loop next (stx-cdr suffix) (cons estx prefix)
|
||||
(cons (with-context (lambda (x)
|
||||
(revappend prefix (cons x (stx-cdr suffix))))
|
||||
(reductions head))
|
||||
rss)))]
|
||||
[(cons (IntW b:expr (renames head) tag) '())
|
||||
(loop '() #f #f
|
||||
(cons (with-context (lambda (x) (revappend prefix (cons x (stx-cdr suffix))))
|
||||
(reductions head))
|
||||
rss))]
|
||||
[(cons (struct b:defvals (renames head)) next)
|
||||
(let ([head-rs
|
||||
(with-context (lambda (x) (revappend prefix (cons x (stx-cdr suffix))))
|
||||
(reductions head))])
|
||||
(loop next (stx-cdr suffix) (cons (deriv-e2 head) prefix)
|
||||
(cons head-rs rss)))]
|
||||
[(cons ($$ b:defstx (renames head rhs) _exni) next)
|
||||
(let* ([estx (deriv-e2 head)]
|
||||
[estx2 (with-syntax ([(?ds ?vars ?rhs) estx]
|
||||
[?rhs* (deriv-e2 rhs)])
|
||||
;;FIXME
|
||||
#'(?ds ?vars ?rhs*))])
|
||||
(loop next (cdr suffix) (cons estx2 prefix)
|
||||
(with-context (lambda (x) (revappend prefix (cons x (stx-cdr suffix))))
|
||||
(cons (with-context (CC (?ds ?vars ?rhs) estx ?rhs)
|
||||
(reductions rhs))
|
||||
(cons (reductions head)
|
||||
rss)))))]
|
||||
[(cons (struct b:splice (renames head tail)) next)
|
||||
(loop next tail prefix
|
||||
(cons (list (walk/foci (deriv-e2 head)
|
||||
(stx-take tail
|
||||
(- (stx-improper-length tail)
|
||||
(stx-improper-length (stx-cdr suffix))))
|
||||
(E (revappend prefix
|
||||
(cons (deriv-e2 head) (stx-cdr suffix))))
|
||||
(E (revappend prefix tail))
|
||||
"Splice block-level begin"))
|
||||
(cons (with-context (lambda (x)
|
||||
(revappend prefix (cons x (stx-cdr suffix))))
|
||||
(reductions head))
|
||||
rss)))]
|
||||
[(cons (struct b:begin (renames head derivs)) next)
|
||||
;; FIXME
|
||||
(error 'unimplemented)]
|
||||
[(cons (struct error-wrap (exn tag _inner)) '())
|
||||
(values (list (make-misstep suffix (E (revappend prefix suffix)) exn))
|
||||
(revappend prefix suffix))]
|
||||
['()
|
||||
(values (apply append (reverse rss))
|
||||
(revappend prefix suffix))])))
|
||||
|
||||
(cond [(pair? brules)
|
||||
(let ([brule0 (car brules)]
|
||||
[next (cdr brules)])
|
||||
(match/with-derivation brule0
|
||||
[(struct b:expr (renames head))
|
||||
(let ([estx (deriv-e2 head)])
|
||||
(loop next (stx-cdr suffix) (cons estx prefix)
|
||||
(cons (with-context (lambda (x) (revappend prefix (cons x (stx-cdr suffix))))
|
||||
(reductions head))
|
||||
rss)))]
|
||||
[(IntW b:expr (renames head) tag)
|
||||
(loop next #f #f
|
||||
(cons (with-context (lambda (x) (revappend prefix (cons x (stx-cdr suffix))))
|
||||
(reductions head))
|
||||
rss))]
|
||||
[(struct b:defvals (renames head))
|
||||
(let ([head-rs
|
||||
(with-context (lambda (x) (revappend prefix (cons x (stx-cdr suffix))))
|
||||
(reductions head))])
|
||||
(loop next (stx-cdr suffix) (cons (deriv-e2 head) prefix)
|
||||
(cons head-rs rss)))]
|
||||
[(AnyQ b:defstx (renames head rhs))
|
||||
(let* ([estx (deriv-e2 head)]
|
||||
[estx2 (with-syntax ([(?ds ?vars ?rhs) estx]
|
||||
[?rhs* (deriv-e2 rhs)])
|
||||
;;FIXME
|
||||
(datum->syntax-object estx `(,#'?ds ,#'?vars ,#'?rhs*) estx estx))])
|
||||
(loop next (cdr suffix) (cons estx2 prefix)
|
||||
(with-context (lambda (x) (revappend prefix (cons x (stx-cdr suffix))))
|
||||
(cons (with-context (CC (?ds ?vars ?rhs) estx ?rhs)
|
||||
(reductions rhs))
|
||||
(cons (reductions head)
|
||||
rss)))))]
|
||||
[(struct b:splice (renames head tail))
|
||||
(loop next tail prefix
|
||||
(cons (list (walk/foci (deriv-e2 head)
|
||||
(stx-take tail
|
||||
(- (stx-improper-length tail)
|
||||
(stx-improper-length (stx-cdr suffix))))
|
||||
(E (revappend prefix
|
||||
(cons (deriv-e2 head) (stx-cdr suffix))))
|
||||
(E (revappend prefix tail))
|
||||
'splice-block))
|
||||
(cons (with-context (lambda (x)
|
||||
(revappend prefix (cons x (stx-cdr suffix))))
|
||||
(reductions head))
|
||||
rss)))]
|
||||
[(struct b:begin (renames head derivs))
|
||||
;; FIXME
|
||||
(error 'unimplemented)]
|
||||
[(struct error-wrap (exn tag _inner))
|
||||
(values (list (stumble/E suffix (E (revappend prefix suffix)) exn))
|
||||
(revappend prefix suffix))]))]
|
||||
[(null? brules)
|
||||
(values (apply append (reverse rss))
|
||||
(revappend prefix suffix))])))
|
||||
|
||||
;; mbrules-reductions : MBRules (list-of syntax) -> ReductionSequence
|
||||
;; The reprocess-on-lift? argument controls the behavior of a mod:lift event.
|
||||
;; In Pass1, #t; in Pass2, #f.
|
||||
|
|
@ -408,71 +419,65 @@
|
|||
(let loop ([mbrules mbrules] [suffix all-stxs] [prefix null])
|
||||
(define (the-context x)
|
||||
(revappend prefix (cons x (stx-cdr suffix))))
|
||||
;(printf "** MB loop~n")
|
||||
;(printf " rules: ~s~n" mbrules)
|
||||
;(printf " suffix: ~s~n" suffix)
|
||||
;(printf " prefix: ~s~n" prefix)
|
||||
(match mbrules
|
||||
[(cons (struct mod:skip ()) next)
|
||||
(loop next (stx-cdr suffix) (cons (stx-car suffix) prefix))]
|
||||
[(cons (struct mod:cons (head)) next)
|
||||
(append (with-context the-context (append (reductions head)))
|
||||
(let ([estx (and (deriv? head) (deriv-e2 head))])
|
||||
(loop next (stx-cdr suffix) (cons estx prefix))))]
|
||||
[(cons (AnyQ mod:prim (head prim)) next)
|
||||
(append (with-context the-context
|
||||
(append (reductions head)
|
||||
(reductions prim)))
|
||||
(let ([estx (and (deriv? head) (deriv-e2 head))])
|
||||
(loop next (stx-cdr suffix) (cons estx prefix))))]
|
||||
[(cons (ErrW mod:splice (head stxs) exn) next)
|
||||
(append (with-context the-context (reductions head))
|
||||
(list (stumble (deriv-e2 head) exn)))]
|
||||
[(cons (struct mod:splice (head stxs)) next)
|
||||
;(printf "suffix is: ~s~n" suffix)
|
||||
;(printf "stxs is: ~s~n" stxs)
|
||||
(append
|
||||
(with-context the-context (reductions head))
|
||||
(let ([suffix-tail (stx-cdr suffix)]
|
||||
[head-e2 (deriv-e2 head)])
|
||||
(cons (walk/foci head-e2
|
||||
(stx-take stxs
|
||||
(- (stx-improper-length stxs)
|
||||
(stx-improper-length suffix-tail)))
|
||||
(E (revappend prefix (cons head-e2 suffix-tail)))
|
||||
(E (revappend prefix stxs))
|
||||
"Splice module-level begin")
|
||||
(cond [(pair? mbrules)
|
||||
(let ([mbrule0 (car mbrules)]
|
||||
[next (cdr mbrules)])
|
||||
(match/with-derivation mbrule0
|
||||
[(struct mod:skip ())
|
||||
(loop next (stx-cdr suffix) (cons (stx-car suffix) prefix))]
|
||||
[(struct mod:cons (head))
|
||||
(append (with-context the-context (append (reductions head)))
|
||||
(let ([estx (and (deriv? head) (deriv-e2 head))])
|
||||
(loop next (stx-cdr suffix) (cons estx prefix))))]
|
||||
[(AnyQ mod:prim (head prim))
|
||||
(append (with-context the-context
|
||||
(append (reductions head)
|
||||
(reductions prim)))
|
||||
(let ([estx (and (deriv? head) (deriv-e2 head))])
|
||||
(loop next (stx-cdr suffix) (cons estx prefix))))]
|
||||
[(ErrW mod:splice (head stxs) exn)
|
||||
(append (with-context the-context (reductions head))
|
||||
(list (stumble (deriv-e2 head) exn)))]
|
||||
[(struct mod:splice (head stxs))
|
||||
(append
|
||||
(with-context the-context (reductions head))
|
||||
(let ([suffix-tail (stx-cdr suffix)]
|
||||
[head-e2 (deriv-e2 head)])
|
||||
(cons (walk/foci head-e2
|
||||
(stx-take stxs
|
||||
(- (stx-improper-length stxs)
|
||||
(stx-improper-length suffix-tail)))
|
||||
(E (revappend prefix (cons head-e2 suffix-tail)))
|
||||
(E (revappend prefix stxs))
|
||||
'splice-module)
|
||||
(loop next stxs prefix))))]
|
||||
[(cons (struct mod:lift (head stxs)) next)
|
||||
;(printf "suffix is: ~s~n~n" suffix)
|
||||
;(printf "stxs is: ~s~n" stxs)
|
||||
(append
|
||||
(with-context the-context (reductions head))
|
||||
(let ([suffix-tail (stx-cdr suffix)]
|
||||
[head-e2 (deriv-e2 head)])
|
||||
(let ([new-suffix (append stxs (cons head-e2 suffix-tail))])
|
||||
(cons (walk/foci null
|
||||
stxs
|
||||
(E (revappend prefix (cons head-e2 suffix-tail)))
|
||||
(E (revappend prefix new-suffix))
|
||||
"Splice definitions from lifted expressions")
|
||||
(loop next
|
||||
new-suffix
|
||||
prefix)))))]
|
||||
[(cons (struct mod:lift-end (tail)) next)
|
||||
(append
|
||||
(if (pair? tail)
|
||||
(list (walk/foci null
|
||||
tail
|
||||
(E (revappend prefix suffix))
|
||||
(E (revappend prefix tail))
|
||||
"Splice lifted module declarations"))
|
||||
null)
|
||||
(loop next tail prefix))]
|
||||
['()
|
||||
(set! final-stxs (reverse prefix))
|
||||
null]))])
|
||||
[(struct mod:lift (head stxs))
|
||||
(append
|
||||
(with-context the-context (reductions head))
|
||||
(let ([suffix-tail (stx-cdr suffix)]
|
||||
[head-e2 (deriv-e2 head)])
|
||||
(let ([new-suffix (append stxs (cons head-e2 suffix-tail))])
|
||||
(cons (walk/foci null
|
||||
stxs
|
||||
(E (revappend prefix (cons head-e2 suffix-tail)))
|
||||
(E (revappend prefix new-suffix))
|
||||
'splice-lifts)
|
||||
(loop next
|
||||
new-suffix
|
||||
prefix)))))]
|
||||
[(struct mod:lift-end (tail))
|
||||
(append
|
||||
(if (pair? tail)
|
||||
(list (walk/foci null
|
||||
tail
|
||||
(E (revappend prefix suffix))
|
||||
(E (revappend prefix tail))
|
||||
'splice-module-lifts))
|
||||
null)
|
||||
(loop next tail prefix))]))]
|
||||
[(null? mbrules)
|
||||
(set! final-stxs (reverse prefix))
|
||||
null]))])
|
||||
(values reductions final-stxs)))
|
||||
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -3,14 +3,61 @@
|
|||
(provide (all-defined))
|
||||
|
||||
;; A ReductionSequence is a (list-of Reduction)
|
||||
|
||||
;; A ProtoStep is (make-protostep Derivation BigContext StepType)
|
||||
|
||||
;; A Reduction is one of
|
||||
;; - (make-step Syntaxes Syntaxes Syntax Syntax BigContext)
|
||||
;; - (make-misstep Syntax Syntax Exception)
|
||||
(define-struct step (redex contractum e1 e2 note lctx) #f)
|
||||
(define-struct misstep (redex e1 exn) #f)
|
||||
;; - (make-step ... Syntaxes Syntaxes Syntax Syntax)
|
||||
;; - (make-misstep ... Syntax Syntax Exception)
|
||||
|
||||
(define-struct protostep (deriv lctx type) #f)
|
||||
|
||||
(define-struct (step protostep) (redex contractum e1 e2) #f)
|
||||
(define-struct (misstep protostep) (redex e1 exn) #f)
|
||||
|
||||
;; A StepType is a simple in the following alist.
|
||||
|
||||
(define-struct (rewrite-step step) () #f)
|
||||
(define-struct (rename-step step) () #f)
|
||||
(define step-type-meanings
|
||||
'((macro-step . "Macro transformation")
|
||||
|
||||
(rename-lambda . "Rename formal parameters")
|
||||
(rename-case-lambda . "Rename formal parameters")
|
||||
(rename-let-values . "Rename bound variables")
|
||||
(rename-letrec-values . "Rename bound variables")
|
||||
(rename-lsv . "Rename bound variables")
|
||||
(lsv-remove-syntax . "Remove syntax bindings")
|
||||
|
||||
(resolve-variable . "Resolve variable (remove extra marks)")
|
||||
(tag-module-begin . "Tag #%module-begin")
|
||||
(tag-app . "Tag application")
|
||||
(tag-datum . "Tag datum")
|
||||
(tag-top . "Tag top-level variable")
|
||||
(capture-lifts . "Capture lifts")
|
||||
|
||||
(local-lift . "Macro lifted expression to top-level")
|
||||
(module-lift . "Macro lifted declaration to end of module")
|
||||
(block->letrec . "Transform block to letrec")
|
||||
(splice-block . "Splice block-level begin")
|
||||
(splice-module . "Splice module-level begin")
|
||||
(splice-lifts . "Splice definitions from lifted expressions")
|
||||
(splice-module-lifts . "Splice lifted module declarations")
|
||||
|
||||
(error . "Error")))
|
||||
|
||||
(define (step-type->string x)
|
||||
(cond [(assq x step-type-meanings) => cdr]
|
||||
[(string? x) x]
|
||||
[else (error 'step-type->string "not a step type: ~s" x)]))
|
||||
|
||||
(define (rename-step? x)
|
||||
(memq (protostep-type x)
|
||||
'(rename-lambda
|
||||
rename-case-lambda
|
||||
rename-let-values
|
||||
rename-letrec-values
|
||||
rename-lsv)))
|
||||
|
||||
(define (rewrite-step? x)
|
||||
(and (step? x) (not (rename-step? x))))
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@
|
|||
|
||||
(define (show-step step partition)
|
||||
(cond [(step? step)
|
||||
(display (step-note step))
|
||||
(display (step-type->string (protostep-type step)))
|
||||
(newline)
|
||||
(show-term (step-e1 step) partition)
|
||||
(display " ==>")
|
||||
|
|
@ -73,7 +73,7 @@
|
|||
(display (exn-message (misstep-exn step)))
|
||||
(newline)
|
||||
(show-term (misstep-e1 step) partition)]))
|
||||
|
||||
|
||||
(define (show-term stx partition)
|
||||
(define-values (datum flat=>stx stx=>flat)
|
||||
(table stx partition 0 'always))
|
||||
|
|
|
|||
|
|
@ -32,9 +32,9 @@
|
|||
|
||||
;; Struct for one-by-one stepping
|
||||
|
||||
(define-struct prestep (redex e1 lctx))
|
||||
(define-struct poststep (contractum e2 note lctx))
|
||||
|
||||
(define-struct (prestep protostep) (redex e1))
|
||||
(define-struct (poststep protostep) (contractum e2))
|
||||
|
||||
;; Macro Stepper
|
||||
|
||||
(define view@
|
||||
|
|
@ -210,9 +210,6 @@
|
|||
;; steps : cursor
|
||||
(define steps #f)
|
||||
|
||||
;; zoomed? : boolean
|
||||
(define zoomed? #f)
|
||||
|
||||
(define warnings-frame #f)
|
||||
|
||||
(define/public (add-deriv d)
|
||||
|
|
@ -331,17 +328,6 @@
|
|||
(set! synth-deriv #f))
|
||||
(refresh))
|
||||
|
||||
(define/private (navigate-zoom-in)
|
||||
(set! zoomed? #t)
|
||||
(update))
|
||||
|
||||
(define/private (navigate-zoom-out)
|
||||
(set! zoomed? #f)
|
||||
(update))
|
||||
|
||||
(define/private (navigate-skip-to)
|
||||
'...)
|
||||
|
||||
(define/private (insert-step-separator text)
|
||||
(send sbview add-text "\n ")
|
||||
(send sbview add-text
|
||||
|
|
@ -371,7 +357,7 @@
|
|||
(update)
|
||||
(send text scroll-to-position (unbox start-box) #f (unbox end-box)))
|
||||
|
||||
(define (update:show-prefix)
|
||||
(define/private (update:show-prefix)
|
||||
;; Show the final terms from the cached synth'd derivs
|
||||
(for-each (lambda (d+sd)
|
||||
(let ([e2 (lift/deriv-e2 (cdr d+sd))])
|
||||
|
|
@ -380,7 +366,7 @@
|
|||
(send sbview add-text "Error\n"))))
|
||||
(reverse derivs-prefix)))
|
||||
|
||||
(define (update:show-current-step)
|
||||
(define/private (update:show-current-step)
|
||||
(when steps
|
||||
(let ([step (cursor:current steps)])
|
||||
(cond [(step? step)
|
||||
|
|
@ -394,45 +380,50 @@
|
|||
[(not step)
|
||||
(update:show-final)]))))
|
||||
|
||||
(define (update:show-lctx lctx)
|
||||
(define/private (update:show-lctx lctx)
|
||||
(when (pair? lctx)
|
||||
(for-each (lambda (bc)
|
||||
(send sbview add-text "While executing macro transformer in:\n")
|
||||
(insert-syntax/redex (cdr bc) (car bc)))
|
||||
(insert-syntax/redex (cddr bc) (cadr bc)))
|
||||
lctx)
|
||||
(send sbview add-text "\n")))
|
||||
|
||||
(define (update:show-step step)
|
||||
(unless zoomed?
|
||||
(update:show-lctx (step-lctx step))
|
||||
(insert-syntax/redex (step-e1 step) (foci (step-redex step)))
|
||||
(insert-step-separator (step-note step))
|
||||
(insert-syntax/contractum (step-e2 step) (foci (step-contractum step))))
|
||||
(when zoomed?
|
||||
(for-each (lambda (s) (insert-syntax s)) (foci (step-redex step)))
|
||||
(insert-step-separator (step-note step))
|
||||
(for-each (lambda (s) (insert-syntax s)) (foci (step-contractum step)))))
|
||||
(define/private (update:show-protostep step)
|
||||
(update:show-lctx (protostep-lctx step)))
|
||||
|
||||
(define (update:show-prestep step)
|
||||
(update:show-lctx (prestep-lctx step))
|
||||
(insert-step-separator/small "Find redex")
|
||||
(define/private (update:separator step)
|
||||
(insert-step-separator (step-type->string (protostep-type step))))
|
||||
|
||||
(define/private (update:separator/small step)
|
||||
(insert-step-separator/small (step-type->string (protostep-type step))))
|
||||
|
||||
(define/private (update:show-step step)
|
||||
(update:show-protostep step)
|
||||
(insert-syntax/redex (step-e1 step) (foci (step-redex step)))
|
||||
(update:separator step)
|
||||
(insert-syntax/contractum (step-e2 step) (foci (step-contractum step))))
|
||||
|
||||
(define/private (update:show-prestep step)
|
||||
(update:show-protostep step)
|
||||
(update:separator/small step)
|
||||
(insert-syntax/redex (prestep-e1 step) (foci (prestep-redex step))))
|
||||
|
||||
(define (update:show-poststep step)
|
||||
(update:show-lctx (poststep-lctx step))
|
||||
(insert-step-separator/small (poststep-note step))
|
||||
(define/private (update:show-poststep step)
|
||||
(update:show-protostep step)
|
||||
(update:separator/small step)
|
||||
(insert-syntax/contractum (poststep-e2 step) (foci (poststep-contractum step))))
|
||||
|
||||
(define (update:show-misstep step)
|
||||
(define/private (update:show-misstep step)
|
||||
(update:show-protostep step)
|
||||
(insert-syntax/redex (misstep-e1 step) (foci (misstep-redex step)))
|
||||
(insert-step-separator "Error")
|
||||
(update:separator step)
|
||||
(send sbview add-text (exn-message (misstep-exn step)))
|
||||
(send sbview add-text "\n")
|
||||
(when (exn:fail:syntax? (misstep-exn step))
|
||||
(for-each (lambda (e) (send sbview add-syntax e))
|
||||
(exn:fail:syntax-exprs (misstep-exn step)))))
|
||||
|
||||
(define (update:show-final)
|
||||
(define/private (update:show-final)
|
||||
(let ([result (lift/deriv-e2 synth-deriv)])
|
||||
(when result
|
||||
(send sbview add-text "Expansion finished\n")
|
||||
|
|
@ -440,7 +431,7 @@
|
|||
(unless result
|
||||
(send sbview add-text "Error\n"))))
|
||||
|
||||
(define (update:show-suffix)
|
||||
(define/private (update:show-suffix)
|
||||
(when (pair? derivs)
|
||||
(for-each (lambda (suffix-deriv)
|
||||
(send sbview add-syntax (lift/deriv-e1 suffix-deriv)))
|
||||
|
|
@ -454,7 +445,7 @@
|
|||
(send text begin-edit-sequence)
|
||||
(send sbview erase-all)
|
||||
|
||||
(unless zoomed? (update:show-prefix))
|
||||
(update:show-prefix)
|
||||
(send sbview add-separator)
|
||||
(set! position-of-interest (send text last-position))
|
||||
(update:show-current-step)
|
||||
|
|
@ -492,15 +483,8 @@
|
|||
(send nav:end enable (and steps (cursor:can-move-next? steps)))
|
||||
(send nav:up enable (and (pair? derivs-prefix)))
|
||||
(send nav:down enable
|
||||
(and (pair? derivs)))
|
||||
#;
|
||||
(send nav:zoom-in enable
|
||||
(and (not zoomed?) steps (step? (cursor:current steps))))
|
||||
#;
|
||||
(send nav:zoom-out enable zoomed?)
|
||||
#;
|
||||
(send nav:jump-to enable #f))
|
||||
|
||||
(and (pair? derivs))))
|
||||
|
||||
;; --
|
||||
|
||||
;; refresh/resynth : -> void
|
||||
|
|
@ -584,13 +568,13 @@
|
|||
(define/private (reduce:one-by-one rs)
|
||||
(let loop ([rs rs])
|
||||
(match rs
|
||||
[(cons (struct step (redex contractum e1 e2 note lctx)) rs)
|
||||
(list* (make-prestep redex e1 lctx)
|
||||
(make-poststep contractum e2 note lctx)
|
||||
[(cons (struct step (d l t redex contractum e1 e2)) rs)
|
||||
(list* (make-prestep d l "Find redex" redex e1)
|
||||
(make-poststep d l t contractum e2)
|
||||
(loop rs))]
|
||||
[(cons (struct misstep (redex e1 exn)) rs)
|
||||
(list* (make-prestep redex e1 null)
|
||||
(make-misstep redex e1 exn)
|
||||
[(cons (struct misstep (d l t redex e1 exn)) rs)
|
||||
(list* (make-prestep d l "Find redex" redex e1)
|
||||
(make-misstep d l t redex e1 exn)
|
||||
(loop rs))]
|
||||
['()
|
||||
null])))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user