* Added delay and force.

src/ikarus.promises.ss

@@ -0,0 +1,26 @@
+
+(library (ikarus promises)
+  (export force make-promise)
+  (import 
+    (except (ikarus) force make-promise))
+
+  (define (force x)
+    (unless (procedure? x) 
+      (error 'force "~s is not a procedure" x))
+    (x))
+
+  (define (make-promise proc)
+    (unless (procedure? proc)
+      (error 'make-promise "~s is not a procedure" proc))
+    (let ([results #f])
+      (lambda () 
+        (if results
+            (apply values results)
+            (call-with-values proc
+              (lambda x*
+                (if results
+                    (apply values results) 
+                    (begin
+                      (set! results x*) 
+                      (apply values x*))))))))))
+

src/ikarus.syntax.ss

@@ -796,6 +796,11 @@
       (syntax-match stx ()
         [(_ expr) 
          (bless `(time-it ',expr (lambda () ,expr)))])))
+  (define delay-macro
+    (lambda (stx)
+      (syntax-match stx ()
+        [(_ expr) 
+         (bless `(make-promise (lambda () ,expr)))])))
   (define identifier-syntax-macro
     (lambda (stx)
       (syntax-match stx ()
@@ -1697,6 +1702,7 @@
            [(with-syntax)       with-syntax-macro]
            [(identifier-syntax) identifier-syntax-macro]
            [(time)              time-macro]
+           [(delay)             delay-macro]
            [(... => _ else unquote unquote-splicing 
              unsyntax unsyntax-splicing)
             incorrect-usage-macro]

src/makefile.ss

@@ -71,6 +71,7 @@
     "ikarus.posix.ss"
     "ikarus.timer.ss"
     "ikarus.bytevectors.ss"
+    "ikarus.promises.ss"
     "ikarus.main.ss"))
 
 (define ikarus-system-macros
@@ -111,6 +112,7 @@
     [and               (macro . and)]
     [or                (macro . or)]
     [time              (macro . time)]
+    [delay             (macro . delay)]
     [...               (macro . ...)]
     [=>                (macro . =>)]
     [else              (macro . else)]
@@ -244,6 +246,7 @@
     [and               i r]
     [or                i r]
     [time              i]
+    [delay               i]
     [...               i r]
     [=>                i r]
     [else              i r]
@@ -805,6 +808,9 @@
     [collect-key                       i]
     [do-stack-overflow                 ]
     [syntax-dispatch                   ]
+    [make-promise                      ]
+    [force                            i]
+
     ))
 
 (define (verify-map)

src/todo-r6rs.ss

@@ -8,16 +8,16 @@
   '(
     [ct (rnrs control (6))]
     [ev (rnrs eval (6))]
-    [fi (rnrs files (6))]
-    [pr (rnrs programs (6))]
     [mp (rnrs mutable-pairs (6))]
     [ms (rnrs mutable-strings (6))]
+    [pr (rnrs programs (6))]
+    [sc (rnrs syntax-case (6))]
+    [fi (rnrs files (6))]
     [ba (rnrs base (6))]
     [ls (rnrs lists (6))]
     [is (rnrs io simple (6))]
     [bv (rnrs bytevectors (6))]
     [sr (rnrs sorting (6))]
-    [sc (rnrs syntax-case (6))]
     [uc (rnrs unicode (6))]
     [ex (rnrs exceptions (6))]
     [bw (rnrs arithmetic bitwise (6))]
@@ -529,9 +529,9 @@
     [command-line                               C pr]
     [exit                                       C pr]
     ;;;
-    [delay                                      S r5 se ne]
+    [delay                                      C r5 se ne]
     [exact->inexact                             C r5 se]
-    [force                                      S r5 se]
+    [force                                      C r5 se]
     [inexact->exact                             C r5 se]
     [modulo                                     C r5 se]
     [remainder                                  C r5 se]