From 2c36427b20aa6186bd660c17973ed2b2c6d993dd Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 7 Apr 2010 02:25:27 +0000
Subject: [PATCH] fix compiler bug with unsafe-c[ad]r and constant folding (PR
 10850)

svn: r18742
---
 collects/tests/mzscheme/unsafe.ss | 10 ++++++++++
 src/mzscheme/src/list.c           |  2 ++
 2 files changed, 12 insertions(+)

diff --git a/collects/tests/mzscheme/unsafe.ss b/collects/tests/mzscheme/unsafe.ss
index bde2372d42..a7bfccc2f5 100644
--- a/collects/tests/mzscheme/unsafe.ss
+++ b/collects/tests/mzscheme/unsafe.ss
@@ -311,4 +311,14 @@
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;; Check that compiling a misapplication of `unsafe-car' and `unsafe-cdr'
+;; (which are folding operations in the compiler ) doesn't crash:
+
+(let ([f (lambda (x) (if x x (unsafe-car 3)))]
+      [g (lambda (x) (if x x (unsafe-cdr 4)))])
+  (test 5 f 5)
+  (test 5 g 5))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (report-errs)
diff --git a/src/mzscheme/src/list.c b/src/mzscheme/src/list.c
index 9f3c85f5ae..869b8b8e8b 100644
--- a/src/mzscheme/src/list.c
+++ b/src/mzscheme/src/list.c
@@ -3196,11 +3196,13 @@ void scheme_init_ephemerons(void)
 
 static Scheme_Object *unsafe_car (int argc, Scheme_Object *argv[])
 {
+  if (scheme_current_thread->constant_folding) return scheme_checked_car(argc, argv);
   return SCHEME_CAR(argv[0]);
 }
 
 static Scheme_Object *unsafe_cdr (int argc, Scheme_Object *argv[])
 {
+  if (scheme_current_thread->constant_folding) return scheme_checked_cdr(argc, argv);
   return SCHEME_CDR(argv[0]);
 }