From e0c82c8ac6d4400c723d2ebace2f8efadd3fd923 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 12 May 2010 15:10:37 -0400 Subject: [PATCH] flatten and filters before using them --- collects/typed-scheme/typecheck/tc-metafunctions.rkt | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/collects/typed-scheme/typecheck/tc-metafunctions.rkt b/collects/typed-scheme/typecheck/tc-metafunctions.rkt index 70bccc44ce..a1ffd028df 100644 --- a/collects/typed-scheme/typecheck/tc-metafunctions.rkt +++ b/collects/typed-scheme/typecheck/tc-metafunctions.rkt @@ -104,12 +104,19 @@ [else (loop (cdr ps) (cons p result))]))))] [_ prop]))) +(define (flatten-props ps) + (let loop ([ps ps]) + (match ps + [(list) null] + [(cons (AndFilter: ps*) ps) (loop (append ps* ps))] + [(cons p ps) (cons p (loop ps))]))) + (d/c (combine-props new-props old-props flag) ((listof Filter/c) (listof Filter/c) (box/c boolean?) . -> . (values (listof (or/c ImpFilter? OrFilter? AndFilter?)) (listof (or/c TypeFilter? NotTypeFilter?)))) (define (atomic-prop? p) (or (TypeFilter? p) (NotTypeFilter? p))) - (define-values (new-atoms new-formulas) (partition atomic-prop? new-props)) + (define-values (new-atoms new-formulas) (partition atomic-prop? (flatten-props new-props))) (let loop ([derived-props null] [derived-atoms new-atoms] [worklist (append old-props new-formulas)])