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

lazy: fix or' and and' to not force last argument

Browse Source 
The `or' and `and' functions already worked correctly; this
fix is for `or' and `and' as applied directly to arguments, which
expands to the `racket/base' `or' and `and' forms.
This commit is contained in:
Matthew Flatt 2012-02-19 07:33:18 -07:00
parent 4b2f78477a
commit 9ca0c34cb2
3 changed files with 60 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/lazy/lazy.rkt
View File

@ -365,14 +365,22 @@
(or (null? xs)
(let loop ([x (car xs)] [xs (cdr xs)])
(if (null? xs) x (and (! x) (loop (car xs) (cdr xs))))))))
(defsubst (~and x ...) (hidden-~ (and (hidden-! x) ...)) ~and *and)
(define-syntax !and
(syntax-rules ()
[(_) (and)]
[(_ x ... y) (and (hidden-! x) ... y)]))
(defsubst (~and x ...) (hidden-~ (!and x ...)) ~and *and)
(define* (*or . xs)
(let ([xs (!list xs)])
(and (pair? xs)
(let loop ([x (car xs)] [xs (cdr xs)])
(if (null? xs) x (or (! x) (loop (car xs) (cdr xs))))))))
(defsubst (~or x ...) (hidden-~ (or (hidden-! x) ...)) ~or *or)
(define-syntax !or
(syntax-rules ()
[(_) (or)]
[(_ x ... y) (or (hidden-! x) ... y)]))
(defsubst (~or x ...) (hidden-~ (!or x ...)) ~or *or)
;; --------------------------------------------------------------------------
;; Special forms that are still special forms since they use ~begin

6
collects/tests/lazy/main.rkt
View File

@ -1,7 +1,9 @@
#lang racket/base
(require tests/eli-tester "promise.rkt" "forcers.rkt" "lang.rkt")
(require tests/eli-tester "promise.rkt" "forcers.rkt" "lang.rkt" "space.rkt")
(test do (promise-tests)
do (forcer-tests)
do (lang-tests))
do (lang-tests)
do (space-tests))

46
collects/tests/lazy/space.rkt Normal file
View File

@ -0,0 +1,46 @@
#lang racket/base
(require tests/eli-tester)
;; tests for space safety, especially for `or' and `and'
(define (space-tests)
(define (one-test first-class?)
(collect-garbage)
(define mem (current-memory-use))
(define t
(thread
(lambda ()
(parameterize ([current-namespace (make-base-namespace)])
(eval
`(module loop lazy
(let ()
(define (list-from n)
(if (= n 500000)
empty
(cons n (list-from (add1 n)))))
,@(if first-class?
`((define my-or or)
(define my-and and))
'())
(define (has-negative? l)
(,(if first-class? 'my-and 'and)
(pair? l)
(,(if first-class? 'my-or 'or)
(negative? (car l))
(has-negative? (rest l)))))
(! (has-negative? (list-from 0))))))
(eval `(require 'loop))))))
(thread (lambda () (let loop ()
(sleep 0.2)
(unless ((current-memory-use) . < . (* 10 mem))
(eprintf "too much memory!")
(kill-thread t))
(when (thread-running? t)
(loop)))))
(sync t)
(void))
(one-test #f)
(one-test #t))
(provide space-tests)