scheme' is now srfi/1-free. (All delete-duplicate' requires were

not necessary.)

svn: r14956
This commit is contained in:
Eli Barzilay 2009-05-23 08:42:17 +00:00
parent 709ba05005
commit b9a7dc01b8
6 changed files with 12 additions and 14 deletions

View File

@ -8,8 +8,7 @@
"reorder.ss"
scheme/struct-info
scheme/stxparam
scheme/nest
(only-in srfi/1 delete-duplicates))
scheme/nest)
(provide compile*)

View File

@ -5,8 +5,7 @@
syntax/stx
scheme/struct-info
"patterns.ss"
"compiler.ss"
(only-in srfi/1 delete-duplicates))
"compiler.ss")
(provide ddk? parse-literal all-vars pattern-var? match:syntax-err
match-expander-transform trans-match parse-struct

View File

@ -7,8 +7,7 @@
"patterns.ss"
"compiler.ss"
"parse-helper.ss"
"parse-quasi.ss"
(only-in srfi/1 delete-duplicates))
"parse-quasi.ss")
(provide parse/legacy/cert)

View File

@ -6,8 +6,7 @@
scheme/struct-info
"patterns.ss"
"compiler.ss"
"parse-helper.ss"
(only-in srfi/1 delete-duplicates))
"parse-helper.ss")
(provide parse-quasi)

View File

@ -7,7 +7,6 @@
"compiler.ss"
"parse-helper.ss"
"parse-quasi.ss"
(only-in srfi/1 delete-duplicates)
(for-template (only-in "runtime.ss" matchable?)
scheme/base))

View File

@ -2,7 +2,6 @@
(require "patterns.ss"
scheme/list
(only-in srfi/1/list take-while)
(for-syntax scheme/base))
(provide reorder-columns)
@ -52,16 +51,20 @@
(define (or-all? ps l)
(ormap (lambda (p) (andmap p l)) ps))
(define (count-while pred l)
(let loop ([l l] [r 0])
(if (or (null? l) (not (pred (car l)))) r (loop (cdr l) (add1 r)))))
(define (score col)
(define n (length col))
(define c (car col))
(define preds (list Var? Pair? Null?))
(cond [(or-all? preds col) (add1 n)]
[(andmap CPat? col) n]
[(Var? c) (length (take-while Var? col))]
[(Pair? c) (length (take-while Pair? col))]
[(Vector? c) (length (take-while Vector? col))]
[(Box? c) (length (take-while Box? col))]
[(Var? c) (count-while Var? col)]
[(Pair? c) (count-while Pair? col)]
[(Vector? c) (count-while Vector? col)]
[(Box? c) (count-while Box? col)]
[else 0]))
(define (reorder-by ps scores*)