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

Use disjoint sum in redex production enumerators

Browse Source
This commit is contained in:
Max New 2014-02-10 05:58:09 -06:00
parent 71a20b9b0b
commit 3b2b1fb977
1 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
pkgs/redex-pkgs/redex-lib/redex/private/enum.rkt
View File

@ -31,6 +31,7 @@
;; cc-enums : promise/c (hash[sym -o> enum]) ;; cc-enums : promise/c (hash[sym -o> enum])
;; unused-var/e : enum ;; unused-var/e : enum
(struct lang-enum (nt-enums delayed-cc-enums unused-var/e)) (struct lang-enum (nt-enums delayed-cc-enums unused-var/e))
(struct production (n term) #:transparent)
(struct repeat (n terms) #:transparent) (struct repeat (n terms) #:transparent)
(struct name-ref (name) #:transparent) (struct name-ref (name) #:transparent)
(struct misname-ref (name tag) #:transparent) (struct misname-ref (name tag) #:transparent)
@ -88,9 +89,16 @@
(pat/e pat l-enum))) (pat/e pat l-enum)))
(define (enumerate-rhss rhss l-enum) (define (enumerate-rhss rhss l-enum)
(apply sum/e (define (with-index i e)
(for/list ([production (in-list rhss)]) (cons (map/e (curry production i)
(pat/e (rhs-pattern production) l-enum)))) production-term
e)
(λ (nd-x) (= i (production-n nd-x)))))
(apply disj-sum/e #:alternate? #t
(for/list ([i (in-naturals)]
[production (in-list rhss)])
(with-index i
(pat/e (rhs-pattern production) l-enum)))))
(define (pat/e pat l-enum) (define (pat/e pat l-enum)
(match-define (ann-pat nv pp-pat) (preprocess pat)) (match-define (ann-pat nv pp-pat) (preprocess pat))
@ -216,6 +224,8 @@
[(ann-pat nv term) [(ann-pat nv term)
(λ (_) (λ (_)
((refs-to-fn term) nv))] ((refs-to-fn term) nv))]
[(production _ term)
(refs-to-fn term)]
[(decomp ctx-refs termpat-refs) [(decomp ctx-refs termpat-refs)
(define ctx-fn (refs-to-fn ctx-refs)) (define ctx-fn (refs-to-fn ctx-refs))
(define term-fn (refs-to-fn termpat-refs)) (define term-fn (refs-to-fn termpat-refs))