Add in-hole and hide-hole enumerators
This commit is contained in:
parent
c23f326b58
commit
aba0880dda
|
@ -31,6 +31,8 @@
|
||||||
(struct repeat (n terms) #:transparent)
|
(struct repeat (n terms) #:transparent)
|
||||||
(struct name-ref (name) #:transparent)
|
(struct name-ref (name) #:transparent)
|
||||||
(struct nrep-ref (name subpat) #:transparent)
|
(struct nrep-ref (name subpat) #:transparent)
|
||||||
|
(struct decomp (ctx term) #:transparent)
|
||||||
|
(struct hide-hole (term) #:transparent)
|
||||||
|
|
||||||
;; Top level exports
|
;; Top level exports
|
||||||
(define enum-ith decode)
|
(define enum-ith decode)
|
||||||
|
@ -62,7 +64,7 @@
|
||||||
|
|
||||||
(define (pat-enumerator l-enum pat)
|
(define (pat-enumerator l-enum pat)
|
||||||
(map/e
|
(map/e
|
||||||
fill-refs
|
to-term
|
||||||
(λ (_)
|
(λ (_)
|
||||||
(redex-error 'pat-enum "Enumerator is not a bijection"))
|
(redex-error 'pat-enum "Enumerator is not a bijection"))
|
||||||
(pat/e pat
|
(pat/e pat
|
||||||
|
@ -114,18 +116,24 @@
|
||||||
var/e)]
|
var/e)]
|
||||||
[`variable-not-otherwise-mentioned
|
[`variable-not-otherwise-mentioned
|
||||||
unused/e]
|
unused/e]
|
||||||
[`hole
|
[`hole (const/e the-hole)]
|
||||||
(const/e the-hole)]
|
|
||||||
[`(nt ,id)
|
[`(nt ,id)
|
||||||
(hash-ref nt-enums id)]
|
(hash-ref nt-enums id)]
|
||||||
[`(name ,n ,pat)
|
[`(name ,n ,pat)
|
||||||
(const/e (name-ref n))]
|
(const/e (name-ref n))]
|
||||||
[`(mismatch-name ,n ,pat)
|
[`(mismatch-name ,n ,pat)
|
||||||
(unimplemented "mismatch-name")]
|
(unimplemented "mismatch-name")]
|
||||||
[`(in-hole ,p1 ,p2) ;; untested
|
[`(in-hole ,p1 ,p2)
|
||||||
(unsupported pat)]
|
(map/e decomp
|
||||||
|
(match-lambda
|
||||||
|
[(decomp ctx term)
|
||||||
|
(values ctx term)])
|
||||||
|
(loop p1)
|
||||||
|
(loop p2))]
|
||||||
[`(hide-hole ,p)
|
[`(hide-hole ,p)
|
||||||
(unsupported pat)]
|
(map/e hide-hole
|
||||||
|
hide-hole-term
|
||||||
|
(loop p))]
|
||||||
[`(side-condition ,p ,g ,e)
|
[`(side-condition ,p ,g ,e)
|
||||||
(unsupported pat)]
|
(unsupported pat)]
|
||||||
[`(cross ,s)
|
[`(cross ,s)
|
||||||
|
@ -175,8 +183,8 @@
|
||||||
names-env
|
names-env
|
||||||
nreps-env)])
|
nreps-env)])
|
||||||
|
|
||||||
;; fill-refs : (ann-pat t-env pat-with-refs) -> redex term
|
;; to-term : (ann-pat t-env pat-with-refs) -> redex term
|
||||||
(define/match (fill-refs ap)
|
(define/match (to-term ap)
|
||||||
[((ann-pat nv term))
|
[((ann-pat nv term))
|
||||||
((refs-to-fn term) nv)])
|
((refs-to-fn term) nv)])
|
||||||
|
|
||||||
|
@ -185,9 +193,19 @@
|
||||||
(match refpat
|
(match refpat
|
||||||
[(ann-pat _ _)
|
[(ann-pat _ _)
|
||||||
(define term
|
(define term
|
||||||
(fill-refs refpat))
|
(to-term refpat))
|
||||||
(λ (_) term)]
|
(λ (_) term)]
|
||||||
|
[(decomp ctx-refs termpat-refs)
|
||||||
|
(define ctx-fn (refs-to-fn ctx-refs))
|
||||||
|
(define term-fn (refs-to-fn termpat-refs))
|
||||||
|
(λ (nv)
|
||||||
|
(define ctx (ctx-fn nv))
|
||||||
|
(define term (term-fn term))
|
||||||
|
(plug-hole ctx term))]
|
||||||
|
[(hide-hole p)
|
||||||
|
(define p-fn (refs-to-fn p))
|
||||||
|
(λ (nv)
|
||||||
|
(hide-hole (p-fn nv)))]
|
||||||
[(name-ref n)
|
[(name-ref n)
|
||||||
(λ (nv)
|
(λ (nv)
|
||||||
(t-env-name-ref nv n))]
|
(t-env-name-ref nv n))]
|
||||||
|
@ -209,6 +227,19 @@
|
||||||
[_ (sequence-fn (list (refs-to-fn subrefpat)))]))))]
|
[_ (sequence-fn (list (refs-to-fn subrefpat)))]))))]
|
||||||
[else (λ (_) refpat)]))
|
[else (λ (_) refpat)]))
|
||||||
|
|
||||||
|
(define (plug-hole ctx term)
|
||||||
|
(define (plug ctx)
|
||||||
|
(match ctx
|
||||||
|
[(? (curry eq? the-hole)) term]
|
||||||
|
[(list ctxs ...) (map plug ctxs)]
|
||||||
|
[_ ctx]))
|
||||||
|
(define (unhide term)
|
||||||
|
(match term
|
||||||
|
[(list ctxs ...) (map unhide ctxs)]
|
||||||
|
[(hide-hole term) (unhide term)]
|
||||||
|
[_ term]))
|
||||||
|
(unhide (plug ctx)))
|
||||||
|
|
||||||
;; (: sequence-fn : (All (a b) (Listof (a -> b)) -> (a -> (Listof b))))
|
;; (: sequence-fn : (All (a b) (Listof (a -> b)) -> (a -> (Listof b))))
|
||||||
(define (sequence-fn fs)
|
(define (sequence-fn fs)
|
||||||
(λ (x)
|
(λ (x)
|
||||||
|
|
|
@ -142,3 +142,16 @@
|
||||||
|
|
||||||
(try-it 100 rec e)
|
(try-it 100 rec e)
|
||||||
(try-it 100 rec v)
|
(try-it 100 rec v)
|
||||||
|
|
||||||
|
;; Hole/in-hole test
|
||||||
|
(define-language Holes
|
||||||
|
(h hole)
|
||||||
|
(ctx (cons hole boolean)
|
||||||
|
(cons boolean hole))
|
||||||
|
(hide (pair ctx (hide-hole ctx)))
|
||||||
|
(i (in-hole ctx number))
|
||||||
|
(i2 (in-hole hide real)))
|
||||||
|
|
||||||
|
(try-it 4 Holes ctx)
|
||||||
|
(try-it 100 Holes i)
|
||||||
|
(try-it 100 Holes i2)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user