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

Add unnamed repeat support

Browse Source
This commit is contained in:
Max New 2013-11-03 23:43:24 -06:00
parent 153a488309
commit e7823c4dac
2 changed files with 17 additions and 9 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

@ -108,7 +108,7 @@
(except/e var/e s)] (except/e var/e s)]
[`(variable-prefix ,s) [`(variable-prefix ,s)
;; todo ;; todo
(error 'unimplemented "var-prefix")] (unimplemented "var-prefix")]
[`variable-not-otherwise-mentioned [`variable-not-otherwise-mentioned
unused/e] unused/e]
[`hole [`hole
@ -277,7 +277,7 @@
;; Only works if there are no variables inside the repeat ;; Only works if there are no variables inside the repeat
(add-named-rep name named-pats)] (add-named-rep name named-pats)]
[`(repeat ,pat ,name ,mismatch) [`(repeat ,pat ,name ,mismatch)
(error 'unimplemented)] (unimplemented "mismatch repeats")]
[else (loop sub-pat named-pats)])) [else (loop sub-pat named-pats)]))
named-pats named-pats
sub-pats)] sub-pats)]
@ -470,7 +470,7 @@
(except/e var/e s)] (except/e var/e s)]
[`(variable-prefix ,s) [`(variable-prefix ,s)
;; todo ;; todo
(error 'unimplemented "var-prefix")] (unimplemented "var-prefix")]
[`variable-not-otherwise-mentioned [`variable-not-otherwise-mentioned
unused-var/e] unused-var/e]
[`hole [`hole
@ -522,7 +522,7 @@
(many/e (loop pat) (many/e (loop pat)
n)))] n)))]
[`(repeat ,pat ,name ,mismatch) [`(repeat ,pat ,name ,mismatch)
(error 'unimplemented "mismatch-repeat")] (unimplemented "mismatch-repeat")]
[else (loop sub-pat)])) [else (loop sub-pat)]))
sub-pats))] sub-pats))]
[(? (compose not pair?)) [(? (compose not pair?))
@ -560,8 +560,6 @@
(many/e char/e))) (many/e char/e)))
(define integer/e (define integer/e
#; ;; Simple "turn down the volume" list
(from-list/e '(0 1 -1))
(sum/e nats (sum/e nats
(map/e (λ (n) (- (+ n 1))) (map/e (λ (n) (- (+ n 1)))
(λ (n) (- (- n) 1)) (λ (n) (- (- n) 1))
@ -599,7 +597,11 @@
[(decomposition? term) [(decomposition? term)
(error 'unsupported "in-hole")] (error 'unsupported "in-hole")]
[(list? term) [(list? term)
(map rec term)] (append*
(for/list ([sub-term (in-list term)])
(cond [(repeat? sub-term)
(map rec (repeat-terms sub-term))]
[else (list (rec sub-term))])))]
[else term])) [else term]))
(rec term)]) (rec term)])

10
pkgs/redex-pkgs/redex-lib/redex/private/preprocess-pat.rkt
View File

@ -5,6 +5,7 @@
"2set.rkt" "2set.rkt"
"env.rkt" "env.rkt"
"error.rkt"
"match-a-pattern.rkt") "match-a-pattern.rkt")
(provide preprocess (provide preprocess
@ -24,7 +25,7 @@
pat)] pat)]
[`(mismatch-name ,n ,subpat) [`(mismatch-name ,n ,subpat)
;; TODO ;; TODO
(error 'unimplemented)] (unimplemented "mismatch-name")]
[`(in-hole ,p1 ,p2) [`(in-hole ,p1 ,p2)
(match-define (ann-pat subenv1 _) (match-define (ann-pat subenv1 _)
(walk p1)) (walk p1))
@ -41,8 +42,10 @@
(define ann-sub-pats (define ann-sub-pats
(for/list ([sub-pat (in-list sub-pats)]) (for/list ([sub-pat (in-list sub-pats)])
(match sub-pat (match sub-pat
[`(repeat ,p #f #f)
(ann-pat empty-env sub-pat)]
[`(repeat ,p ,n ,m) [`(repeat ,p ,n ,m)
(error 'unimplemented)] (unimplemented "named repeat")]
[_ (walk sub-pat)]))) [_ (walk sub-pat)])))
(define list-env (define list-env
@ -125,3 +128,6 @@
(define (pure-ann-pat pat) (define (pure-ann-pat pat)
(ann-pat empty-env pat)) (ann-pat empty-env pat))
(define (unimplemented pat-name)
(redex-error 'unsupported "generate-term #:i-th currently doesn't support pattern type: ~a" pat-name))