From bc3fa73ec4860931cc07907dae668ca5522767a8 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Wed, 8 Nov 2017 22:56:02 +0900
Subject: [PATCH] adding unambiguous promise? to core

---
 lib/init-7.scm      |  5 ++++-
 lib/scheme/lazy.sld | 14 +-------------
 2 files changed, 5 insertions(+), 14 deletions(-)

diff --git a/lib/init-7.scm b/lib/init-7.scm
index c1d323ff..b0dc3a90 100644
--- a/lib/init-7.scm
+++ b/lib/init-7.scm
@@ -1079,8 +1079,11 @@
  (auto-force
   )
  (else
+  (define *promise-tag* (list 'promise))
   (define (promise done? proc)
-    (list (cons done? proc)))
+    (cons (cons done? proc) *promise-tag*))
+  (define (promise? x)
+    (and (pair? x) (eq? *promise-tag* (cdr x))))
   (define (promise-done? x) (car (car x)))
   (define (promise-value x) (cdr (car x)))
   (define (promise-update! new old)
diff --git a/lib/scheme/lazy.sld b/lib/scheme/lazy.sld
index b9a06e8b..96b5b7bf 100644
--- a/lib/scheme/lazy.sld
+++ b/lib/scheme/lazy.sld
@@ -4,16 +4,4 @@
   (export delay force delay-force make-promise promise?)
   (begin
     (define (make-promise x)
-      (delay x)))
-  (cond-expand
-   (auto-force
-    )
-   (else
-    (begin
-      (define (promise? x)
-        (and (pair? x)
-             (null? (cdr x))
-             (pair? (car x))
-             (or (eq? #t (caar x))
-                 (and (eq? #f (caar x))
-                      (procedure? (cdar x))))))))))
+      (delay x))))