suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Deletes code that should have been deleted when named holes went away

Browse Source
This commit is contained in:
Casey Klein 2011-04-14 14:01:18 -05:00
parent ff7aba9750
commit 319ae5f825
1 changed files with 38 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
collects/redex/private/matcher.rkt
View File

@ -51,9 +51,11 @@ before the pattern compiler is invoked.
;; repeat = (make-repeat compiled-pattern (listof rib) (union #f symbol) boolean) ;; repeat = (make-repeat compiled-pattern (listof rib) (union #f symbol) boolean)
(define-struct repeat (pat empty-bindings suffix mismatch?) #:inspector (make-inspector)) ;; inspector for tests below (define-struct repeat (pat empty-bindings suffix mismatch?) #:inspector (make-inspector)) ;; inspector for tests below
;; compiled-pattern : exp (union #f none sym) -> (union #f (listof mtch)) ;; compiled-pattern : exp hole-info -> (union #f (listof mtch))
;; mtch = (make-mtch bindings sexp[context w/none-inside for the hole] (union none sexp[hole])) ;; mtch = (make-mtch bindings sexp[context] (union none sexp[hole]))
;; mtch is short for "match" ;; hole-info = boolean
;; #f means we're not in a `in-hole' context
;; #t means we're looking for a hole
(define-values (mtch-bindings mtch-context mtch-hole make-mtch mtch?) (define-values (mtch-bindings mtch-context mtch-hole make-mtch mtch?)
(let () (let ()
(define-struct mtch (bindings context hole) #:inspector (make-inspector)) (define-struct mtch (bindings context hole) #:inspector (make-inspector))
@ -66,7 +68,6 @@ before the pattern compiler is invoked.
(make-mtch a b c)) (make-mtch a b c))
mtch?))) mtch?)))
;; used to mean no context is available; also used as the "name" for an unnamed (ie, normal) hole
(define none (define none
(let () (let ()
(define-struct none ()) (define-struct none ())
@ -83,9 +84,6 @@ before the pattern compiler is invoked.
;; pict-builder ;; pict-builder
;; (listof symbol) ;; (listof symbol)
;; (listof (listof symbol))) -- keeps track of `primary' non-terminals ;; (listof (listof symbol))) -- keeps track of `primary' non-terminals
;; hole-info = (union #f none)
;; #f means we're not in a `in-hole' context
;; none means we're looking for a hole
(define-struct compiled-lang (lang cclang ht list-ht across-ht across-list-ht (define-struct compiled-lang (lang cclang ht list-ht across-ht across-list-ht
has-hole-ht cache bind-names-cache pict-builder has-hole-ht cache bind-names-cache pict-builder
@ -683,7 +681,7 @@ before the pattern compiler is invoked.
none))))))) none)))))))
#f)] #f)]
[`hole [`hole
(values (match-hole none) #t)] (values match-hole #t)]
[(? string?) [(? string?)
(values (values
(lambda (exp hole-info) (lambda (exp hole-info)
@ -733,7 +731,7 @@ before the pattern compiler is invoked.
(let-values ([(match-context ctxt-has-hole?) (compile-pattern/default-cache context)] (let-values ([(match-context ctxt-has-hole?) (compile-pattern/default-cache context)]
[(match-contractum contractum-has-hole?) (compile-pattern/default-cache contractum)]) [(match-contractum contractum-has-hole?) (compile-pattern/default-cache contractum)])
(values (values
(match-in-hole context contractum exp match-context match-contractum none) (match-in-hole context contractum exp match-context match-contractum)
(or ctxt-has-hole? contractum-has-hole?)))] (or ctxt-has-hole? contractum-has-hole?)))]
[`(hide-hole ,p) [`(hide-hole ,p)
(let-values ([(match-pat has-hole?) (compile-pattern/default-cache p)]) (let-values ([(match-pat has-hole?) (compile-pattern/default-cache p)])
@ -1126,27 +1124,21 @@ before the pattern compiler is invoked.
(printf "Overall miss rate: ~a%\n" (printf "Overall miss rate: ~a%\n"
(floor (* 100 (/ overall-miss (+ overall-hits overall-miss))))))))) (floor (* 100 (/ overall-miss (+ overall-hits overall-miss)))))))))
;; match-hole : (union none symbol) -> compiled-pattern ;; match-hole : compiled-pattern
(define (match-hole hole-id) (define (match-hole exp hole-info)
(let ([mis-matched-hole
(λ (exp)
(and (hole? exp)
(list (make-mtch (make-bindings '())
the-hole
none))))])
(lambda (exp hole-info)
(if hole-info (if hole-info
(if (eq? hole-id hole-info)
(list (make-mtch (make-bindings '()) (list (make-mtch (make-bindings '())
the-hole the-hole
exp)) exp))
(mis-matched-hole exp)) (and (hole? exp)
(mis-matched-hole exp))))) (list (make-mtch (make-bindings '())
the-hole
none)))))
;; match-in-hole : sexp sexp sexp compiled-pattern compiled-pattern hole-info -> compiled-pattern ;; match-in-hole : sexp sexp sexp compiled-pattern compiled-pattern -> compiled-pattern
(define (match-in-hole context contractum exp match-context match-contractum hole-info) (define (match-in-hole context contractum exp match-context match-contractum)
(lambda (exp old-hole-info) (lambda (exp old-hole-info)
(let ([mtches (match-context exp hole-info)]) (let ([mtches (match-context exp #t)])
(and mtches (and mtches
(let loop ([mtches mtches] (let loop ([mtches mtches]
[acc null]) [acc null])
@ -1174,8 +1166,7 @@ before the pattern compiler is invoked.
(bindings-table bindings))) (bindings-table bindings)))
(build-nested-context (build-nested-context
(mtch-context mtch) (mtch-context mtch)
(mtch-context contractum-mtch) (mtch-context contractum-mtch))
hole-info)
(mtch-hole contractum-mtch)) (mtch-hole contractum-mtch))
acc)))])) acc)))]))
(loop (cdr mtches) acc)))])))))) (loop (cdr mtches) acc)))]))))))
@ -1555,12 +1546,9 @@ before the pattern compiler is invoked.
(define (build-append-context e1 e2) (append e1 e2)) (define (build-append-context e1 e2) (append e1 e2))
(define (build-list-context x) (list x)) (define (build-list-context x) (list x))
(define (reverse-context x) (reverse x)) (define (reverse-context x) (reverse x))
(define (build-nested-context c1 c2 hole-info) (define (build-nested-context c1 c2)
(plug c1 c2 hole-info)) (plug c1 c2))
(define plug (define (plug exp hole-stuff)
(case-lambda
[(exp hole-stuff) (plug exp hole-stuff none)]
[(exp hole-stuff hole-info)
(let ([done? #f]) (let ([done? #f])
(let loop ([exp exp]) (let loop ([exp exp])
(cond (cond
@ -1574,7 +1562,7 @@ before the pattern compiler is invoked.
exp exp
(begin (set! done? #t) (begin (set! done? #t)
hole-stuff))] hole-stuff))]
[else exp])))])) [else exp]))))
;; ;;
;; end context adt ;; end context adt