diff --git a/collects/scheme/list.ss b/collects/scheme/list.ss
index 3452f54316..64b8ff34ba 100644
--- a/collects/scheme/list.ss
+++ b/collects/scheme/list.ss
@@ -10,6 +10,8 @@
 
          drop
          take
+         drop-right
+         take-right
 
          append*
          flatten
@@ -73,20 +75,51 @@
 (define empty? (lambda (l) (null? l)))
 (define empty '())
 
-(define drop list-tail)
+;; internal use below
+(define (drop* list n) ; no error checking, returns #f if index is too large
+  (if (zero? n) list (and (pair? list) (drop* (cdr list) (sub1 n)))))
+(define (too-large who list n)
+  (raise-mismatch-error
+   who
+   (format "index ~e too large for list~a: ~e"
+           n (if (list? list) "" " (not a proper list)") list)
+   n))
+
 (define (take list0 n0)
-  (unless (and (integer? n0) (exact? n0))
-    (raise-type-error 'take "non-negative integer" n0))
+  (unless (exact-nonnegative-integer? n0)
+    (raise-type-error 'take "non-negative exact integer" n0))
   (let loop ([list list0] [n n0])
     (cond [(zero? n) '()]
           [(pair? list) (cons (car list) (loop (cdr list) (sub1 n)))]
-          [else (raise-mismatch-error
-                 'take
-                 (format "index ~e too large for list~a: ~e"
-                         n0
-                         (if (list? list) "" " (not a proper list)")
-                         list0)
-                 n0)])))
+          [else (too-large 'take list0 n0)])))
+
+(define (drop list n)
+  ;; could be defined as `list-tail', but this is better for errors anyway
+  (unless (exact-nonnegative-integer? n)
+    (raise-type-error 'drop "non-negative exact integer" n))
+  (or (drop* list n) (too-large 'drop list n)))
+
+;; take/drop-right are originally from srfi-1, uses the same lead-pointer trick
+
+(define (take-right list n)
+  (unless (exact-nonnegative-integer? n)
+    (raise-type-error 'take-right "non-negative exact integer" n))
+  (let loop ([lag list]
+             [lead (or (drop* list n) (too-large 'take-right list n))])
+    ;; could throw an error for non-lists, but be more like `take'
+    (if (pair? lead)
+      (loop (cdr lag) (cdr lead))
+      lag)))
+
+(define (drop-right list n)
+  (unless (exact-nonnegative-integer? n)
+    (raise-type-error 'drop-right "non-negative exact integer" n))
+  (let loop ([lag list]
+             [lead (or (drop* list n) (too-large 'drop-right list n))])
+    ;; could throw an error for non-lists, but be more like `drop'
+    (if (pair? lead)
+      (cons (car lag) (loop (cdr lag) (cdr lead)))
+      '())))
 
 (define append*
   (case-lambda [(ls) (apply append ls)] ; optimize common case
@@ -194,7 +227,7 @@
 ;;             (values (if (pair? out) (cons x in) l) out)
 ;;             (values in (if (pair? in) (cons x out) l))))))))
 
-;; But that one is slower than this, probably due to value packages
+;; But that one is slower than this, probably due to value packaging
 (define (partition pred l)
   (unless (and (procedure? pred) (procedure-arity-includes? pred 1))
     (raise-type-error 'partition "procedure (arity 1)" pred))
diff --git a/collects/scribblings/reference/pairs.scrbl b/collects/scribblings/reference/pairs.scrbl
index 1b1e2e2aae..b8eee8635e 100644
--- a/collects/scribblings/reference/pairs.scrbl
+++ b/collects/scribblings/reference/pairs.scrbl
@@ -516,10 +516,6 @@ Like @scheme[assoc], but finds an element using the predicate
 @defproc[(last-pair [p pair?]) pair?]{
 Returns the last pair of a (possibly improper) list.}
 
-@defproc[(drop [lst any/c] [pos nonnegative-exact-integer?]) list?]{
-Synonym for @scheme[list-tail].
-}
-
 @defproc[(take [lst any/c] [pos nonnegative-exact-integer?]) list?]{
 Returns a fresh list whose elements are the first @scheme[pos] elements of
 @scheme[lst].  If @scheme[lst] has fewer than
@@ -533,6 +529,35 @@ must merely start with a chain of at least @scheme[pos] pairs.
  (take 'non-list 0)
 ]}
 
+@defproc[(drop [lst any/c] [pos nonnegative-exact-integer?]) any/c]{
+Just like @scheme[list-tail].}
+
+@defproc[(take-right [lst any/c] [pos nonnegative-exact-integer?]) any/c]{
+Returns the @scheme[list]'s @scheme[pos]-length tail. If @scheme[lst]
+has fewer than @scheme[pos] elements, then the
+@exnraise[exn:fail:contract].
+
+The @scheme[lst] argument need not actually be a list; @scheme[lst]
+must merely end with a chain of at least @scheme[pos] pairs.
+
+@examples[#:eval list-eval
+ (take-right '(1 2 3 4) 2)
+ (take-right 'non-list 0)
+]}
+
+@defproc[(drop-right [lst any/c] [pos nonnegative-exact-integer?]) list?]{
+Returns a fresh list whose elements are the prefix of @scheme[lst],
+dropping its @scheme[pos]-length tail. If @scheme[lst] has fewer than
+@scheme[pos] elements, then the @exnraise[exn:fail:contract].
+
+The @scheme[lst] argument need not actually be a list; @scheme[lst]
+must merely end with a chain of at least @scheme[pos] pairs.
+
+@examples[#:eval list-eval
+ (drop-right '(1 2 3 4) 2)
+ (drop-right 'non-list 0)
+]}
+
 @defproc[(add-between [lst list?] [v any/c]) list?]{
 
 Returns a list with the same elements as @scheme[lst], but with
diff --git a/collects/tests/mzscheme/list.ss b/collects/tests/mzscheme/list.ss
index d7d81e7406..5179fdf435 100644
--- a/collects/tests/mzscheme/list.ss
+++ b/collects/tests/mzscheme/list.ss
@@ -145,33 +145,27 @@
     (test '(1 2 3 4) sort '(4 2 3 1) < #:key getkey #:cache-keys? #t)
     (test #t = c 10)))
 
-;; ---------- take/drop ----------
+;; ---------- take/drop[-right] ----------
 (let ()
+  (define funs (list take drop take-right drop-right))
   (define tests
-    ;; ------call------- --take--- --drop---
-    '([(? (a b c d) 2)   (a b)     (c d)    ]
-      [(? (a b c d) 0)   ()        (a b c d)]
-      [(? (a b c d) 4)   (a b c d) ()       ]
-      [(? (a b c . d) 1) (a)       (b c . d)]
-      [(? (a b c . d) 3) (a b c)   d        ]
-      [(? 99 0)          ()        99       ]))
-  (for ([t tests])
-    (apply test (cadr t)  take (cdar t))
-    (apply test (caddr t) drop (cdar t)))
-  (arity-test take 2 2)
-  (arity-test drop 2 2)
-  (err/rt-test (drop 1 1) exn:application:mismatch?)
-  (err/rt-test (take 1 1) exn:application:mismatch?)
-  (err/rt-test (drop '(1 2 3) 2.0))
-  (err/rt-test (take '(1 2 3) 2.0))
-  (err/rt-test (drop '(1) '(1)))
-  (err/rt-test (take '(1) '(1)))
-  (err/rt-test (drop '(1) -1))
-  (err/rt-test (take '(1) -1))
-  (err/rt-test (drop '(1) 2) exn:application:mismatch?)
-  (err/rt-test (take '(1) 2) exn:application:mismatch?)
-  (err/rt-test (drop '(1 2 . 3) 3) exn:application:mismatch?)
-  (err/rt-test (take '(1 2 . 3) 3) exn:application:mismatch?))
+    ;; -----args------ --take--- --drop--- --take-r--- --drop-r-
+    '([((a b c d) 2)   (a b)     (c d)     (c d)       (a b)    ]
+      [((a b c d) 0)   ()        (a b c d) ()          (a b c d)]
+      [((a b c d) 4)   (a b c d) ()        (a b c d)   ()       ]
+      [((a b c . d) 1) (a)       (b c . d) (c . d)     (a b)    ]
+      [((a b c . d) 3) (a b c)   d         (a b c . d) ()       ]
+      [(99 0)          ()        99        99          ()       ]))
+  (for ([t tests] #:when #t [expect (cdr t)] [fun funs])
+    (apply test expect fun (car t)))
+  (for ([fun funs])
+    (arity-test fun 2 2)
+    (err/rt-test (fun 1 1) exn:application:mismatch?)
+    (err/rt-test (fun '(1 2 3) 2.0))
+    (err/rt-test (fun '(1) '(1)))
+    (err/rt-test (fun '(1) -1))
+    (err/rt-test (fun '(1) 2) exn:application:mismatch?)
+    (err/rt-test (fun '(1 2 . 3) 3) exn:application:mismatch?)))
 
 ;; ---------- append* ----------
 (let ()