From 1ab2a41092d9b64a3d7744bd7f0c3fea7248c021 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 14 Jan 2010 20:00:37 +0000 Subject: [PATCH] Paths for `first' and `rest' svn: r17654 --- collects/tests/typed-scheme/succeed/empty-or.ss | 8 ++++---- collects/typed-scheme/private/base-env.ss | 10 ++++++++-- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/collects/tests/typed-scheme/succeed/empty-or.ss b/collects/tests/typed-scheme/succeed/empty-or.ss index cb4d8a1f0d..ba96025d92 100644 --- a/collects/tests/typed-scheme/succeed/empty-or.ss +++ b/collects/tests/typed-scheme/succeed/empty-or.ss @@ -12,10 +12,10 @@ (cond [(if (empty? l) #t (empty? k)) empty] - [(and (number? (car l)) (number? (car k))) - (cons (+ (car l) (car k)) (mrg (cdr l) (cdr k)))] - [(number? (car l)) - (cons (car l) (mrg (rest l) (rest k)))] + [(and (number? (first l)) (number? (first k))) + (cons (+ (first l) (first k)) (mrg (rest l) (rest k)))] + [(number? (first l)) + (cons (first l) (mrg (rest l) (rest k)))] [else (error 'fail)])) diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss index 7824be3172..7269452768 100644 --- a/collects/typed-scheme/private/base-env.ss +++ b/collects/typed-scheme/private/base-env.ss @@ -32,7 +32,10 @@ [cddr (-poly (a) (-> (-lst a) (-lst a)))] [cdddr (-poly (a) (-> (-lst a) (-lst a)))] -[first (-poly (a b) (cl-> [((-pair a b)) a] [((-lst a)) a]))] +[first (-poly (a b) + (cl->* + (->acc (list (-pair a b)) a (list -car)) + (->* (list (-lst a)) a)))] [second (-poly (a b c) (cl-> [((-pair a (-pair b c))) b] [((-lst a)) a]))] @@ -42,7 +45,10 @@ [fourth (-poly (a) ((-lst a) . -> . a))] [fifth (-poly (a) ((-lst a) . -> . a))] [sixth (-poly (a) ((-lst a) . -> . a))] -[rest (-poly (a) ((-lst a) . -> . (-lst a)))] +[rest (-poly (a b) + (cl->* + (->acc (list (-pair a b)) b (list -cdr)) + (->* (list (-lst a)) (-lst a))))] [cons (-poly (a b) (cl-> [(a (-lst a)) (-lst a)]