Closure is not a pair.

* module/mes/base.mes (closure_p, mes_car, mes_cdr): New function.
  (pair_p): Closure is not a pair.
* NEWS: Mention it.
* psyntax-0.mes (self-evaluating?): Add closure?.

diff --git a/NEWS b/NEWS
index 0495be8f055f0eef99b3d48444495f8225ff1b6f..621578b37f69f9ac9a018a3d35e1001f88166ab8 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -22,6 +22,8 @@ block-comments are all handled by the Scheme reader later.
 *** Lambda* and define* are now supported.
 *** #;-comment is now supported.
 *** Non-nested #| |#-comment is now supported.
 *** Lambda* and define* are now supported.
 *** #;-comment is now supported.
 *** Non-nested #| |#-comment is now supported.

+** Noteworthy bug fixes
+*** Closure is not a pair.

 * Changes in 0.3 since 0.2
 ** Core
 *** Number-based rather than pointer-based cells.
 * Changes in 0.3 since 0.2
 ** Core
 *** Number-based rather than pointer-based cells.

diff --git a/module/mes/base.mes b/module/mes/base.mes
index 7ac4b4d99ef139025a2fa8f9e2cdab6a2e0ac5f9..e35100007125d896484ee6b015b5963c82597751 100644 (file)
--- a/module/mes/base.mes
+++ b/module/mes/base.mes
@@ -59,5 +59,5 @@
 (define (procedure? p)
   (cond ((builtin? p) #t)
         ((and (pair? p) (eq? (car p) 'lambda)))
 (define (procedure? p)
   (cond ((builtin? p) #t)
         ((and (pair? p) (eq? (car p) 'lambda)))

-        ((and (pair? p) (eq? (car p) '*closure*)))
+        ((closure? p) #t)

         (#t #f)))
         (#t #f)))

diff --git a/module/mes/psyntax-0.mes b/module/mes/psyntax-0.mes
index 04bb1d6d48d5fbb2e460449a39e43bf0d43f2c4d..350dc6c9bd4ffb9fce805577a41981e6e46f4645 100644 (file)
--- a/module/mes/psyntax-0.mes
+++ b/module/mes/psyntax-0.mes
@@ -33,7 +33,7 @@
 
 (define annotation? (lambda (x) #f))
 (define (self-evaluating? x)
 
 (define annotation? (lambda (x) #f))
 (define (self-evaluating? x)

-  (or (boolean? x) (number? x) (string? x) (char? x) (null? x)))
+  (or (boolean? x) (number? x) (string? x) (char? x) (null? x) (closure? x)))

 
 (define (void) (if #f #f))
 
 
 (define (void) (if #f #f))
 

diff --git a/tests/closure.test b/tests/closure.test
index 494daca8291cc336f9752269b196c7ecfbf2df41..809871920b68d9a9412d4ef981d7576a7fb66f73 100755 (executable)
--- a/tests/closure.test
+++ b/tests/closure.test
@@ -95,4 +95,10 @@ exit $?
     "noexpand")
    (pass-if "closure 9" (sc-expand))))
 
     "noexpand")
    (pass-if "closure 9" (sc-expand))))
 

+(pass-if "closure is procedure"
+             (procedure? (lambda () #t)))
+
+(pass-if-not "closure is not a pair"
+             (pair? (lambda () #t)))
+

 (result 'report)
 (result 'report)

diff --git a/type.c b/type.c
index ca28387ae520145fb38b307492617afa2eef4aba..c8d5933bb59851ac7bbe814f768cba79b6e7eb8a 100644 (file)
--- a/type.c
+++ b/type.c
@@ -26,6 +26,24 @@ char_p (SCM x)
   return TYPE (x) == CHAR ? cell_t : cell_f;
 }
 
   return TYPE (x) == CHAR ? cell_t : cell_f;
 }
 

+SCM
+closure_p (SCM x)
+{
+  return (TYPE (x) == PAIR && CAR (x) == cell_closure) ? cell_t : cell_f;
+}
+
+SCM
+mes_car (SCM x)
+{
+  return CAR (x);
+}
+
+SCM
+mes_cdr (SCM x)
+{
+  return CDR (x);
+}
+

 SCM
 keyword_p (SCM x)
 {
 SCM
 keyword_p (SCM x)
 {


@@ -47,7 +65,7 @@ number_p (SCM x)
 SCM
 pair_p (SCM x)
 {
 SCM
 pair_p (SCM x)
 {

-  return TYPE (x) == PAIR ? cell_t : cell_f;
+  return (TYPE (x) == PAIR && CAR (x) != cell_closure) ? cell_t : cell_f;

 }
 
 SCM
 }
 
 SCM