Add unnamed repeat support

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

View File

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

View File

@ -5,6 +5,7 @@
"2set.rkt"
"env.rkt"
"error.rkt"
"match-a-pattern.rkt")
(provide preprocess
@ -24,7 +25,7 @@
pat)]
[`(mismatch-name ,n ,subpat)
;; TODO
(error 'unimplemented)]
(unimplemented "mismatch-name")]
[`(in-hole ,p1 ,p2)
(match-define (ann-pat subenv1 _)
(walk p1))
@ -41,8 +42,10 @@
(define ann-sub-pats
(for/list ([sub-pat (in-list sub-pats)])
(match sub-pat
[`(repeat ,p #f #f)
(ann-pat empty-env sub-pat)]
[`(repeat ,p ,n ,m)
(error 'unimplemented)]
(unimplemented "named repeat")]
[_ (walk sub-pat)])))
(define list-env
@ -125,3 +128,6 @@
(define (pure-ann-pat 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))