->i now evaluates the arguments in the proper order

This commit is contained in:
Robby Findler 2010-08-04 10:42:19 -05:00
parent d2894e7a8e
commit 3b431c6ff2
2 changed files with 54 additions and 18 deletions

View File

@ -75,13 +75,32 @@
#:first-order (λ (ctc) (λ (x) #f)) ;; WRONG
#:stronger (λ (this that) #f))) ;; WRONG
;; find-ordering : (listof arg) -> (listof (cons number arg))
;; find-ordering : (listof arg) -> (values (listof arg) (listof number))
;; sorts the arguments according to the dependency order.
;; returns them in the reverse of that order, ie expressions that need
;; to be evaluted first come later in the list.
(define-for-syntax (find-ordering args)
(values (reverse args)
(reverse
(for/list ([arg (in-list args)]
[i (in-naturals)])
i))))
(define (comes-before? x y)
(cond
[(depends-on? (car x) (car y)) #t]
[(depends-on? (car y) (car x)) #f]
[else (< (cdr x) (cdr y))]))
(define (depends-on? arg1 arg2)
(and (arg-vars arg2)
(ormap (λ (x) (free-identifier=? x (arg-var arg1)))
(arg-vars arg2))))
(let* ([numbered (for/list ([arg (in-list args)]
[i (in-naturals)])
(cons arg i))]
[sorted
(sort
numbered
(λ (x y) (not (comes-before? x y))))])
(values (map car sorted)
(map cdr sorted))))
;; args/vars->arglist : (listof arg?) (vectorof identifier?) -> syntax
;; (vector-length vars) = (length args)

View File

@ -2,23 +2,32 @@
(require racket/contract
racket/pretty)
#;
(pretty-print
(syntax->datum (expand-once
#'(->i ([x number?] [y (x) (<=/c x)]) any))))
(pretty-print
(syntax->datum (expand
#'(->i ([x number?] [y number?] [z (x y) (if (<= x y) (<=/c x) (<=/c y))]) any))))
#'(->i ([x number?]
[y (x z) (between/c x z)]
[z number?])
any))))
#;
((contract (->i ([x number?] [y (x) (<=/c x)]) any)
(λ (x y) (+ x y))
(pretty-print
(syntax->datum (expand
#'(->i ([x number?]
[y (x z) (between/c x z)]
[z number?])
any))))
((contract (->i ([x number?]
[y (x z) (between/c x z)]
[z number?])
any)
(λ (x y z) (+ x y z))
'pos 'neg)
-1 -1)
1 2 3)
;; => 6
#|
;; timing tests:
(define f1
@ -48,7 +57,7 @@
'f1 (tme f1)
'f2 (tme f2)
|#
#|
test cases:
@ -158,5 +167,13 @@ test cases:
[y (x) number?])
;; => no syntax error
((contract (->i ([x number?]
[y (x z) (between/c x z)]
[z number?])
any)
(λ (x y z) (+ x y z))
'pos 'neg)
1 2 3)
;; => 6
|#