* added call-with-current-continuation.

src/ikarus.control.ss

@@ -1,10 +1,11 @@
 
 
 (library (ikarus control)
-  (export call/cf call/cc dynamic-wind exit)
+  (export call/cf call/cc call-with-current-continuation dynamic-wind exit)
   (import 
     (ikarus system $stack)
-    (except (ikarus) call/cf call/cc dynamic-wind exit))
+    (except (ikarus) call/cf call/cc call-with-current-continuation
+            dynamic-wind exit))
 
   (define primitive-call/cf
     (lambda (f)
@@ -85,6 +86,10 @@
                   (unless (eq? save winders) (do-wind save))
                   (apply k v1 v2 v*)])))))))
 
+  (define call-with-current-continuation
+          ;; look at how verbose I am ;;
+    (lambda (f) (call/cc f)))
+
   (define dynamic-wind
     (lambda (in body out)
       (in)

src/ikarus.library-manager.ss

@@ -93,7 +93,6 @@
           (let f ([ls (library-path)])
             (and (pair? ls)
                  (let ([name (string-append (car ls) str)])
-                   (printf "trying ~s\n" name)
                    (if (file-exists? name)
                        name
                        (f (cdr ls))))))))

src/ikarus.syntax.ss

@@ -775,6 +775,31 @@
              (bless `(letrec ([,f (lambda ,lhs* ,b . ,b*)])
                         (,f . ,rhs*)))
              (stx-error stx "invalid syntax"))])))
+  (define do-macro
+    (lambda (stx)
+      (define bind
+        (lambda (x)
+          (syntax-match x ()
+            [(x init)      `(,x ,init ,x)]
+            [(x init step) `(,x ,init ,step)]
+            [_  (stx-error stx "invalid binding")])))
+      (syntax-match stx ()
+        [(_ (binding* ...)
+            (test expr* ...)
+            command* ...)
+         (syntax-match (map bind binding*) ()
+           [([x* init* step*] ...)
+            (if (valid-bound-ids? x*)
+                (bless 
+                  `(letrec ([loop 
+                             (lambda ,x*
+                               (if ,test 
+                                 (begin (void) ,@expr*)
+                                 (begin 
+                                   ,@command* 
+                                   (loop ,@step*))))])
+                     (loop ,@init*)))
+                (stx-error stx "duplicate bindings"))])])))
   (define let*-macro
     (lambda (stx)
       (syntax-match stx ()
@@ -1514,6 +1539,7 @@
            [(include)       include-macro]
            [(cond)          cond-macro]
            [(let)           let-macro]
+           [(do)            do-macro]
            [(or)            or-macro]
            [(and)           and-macro]
            [(let*)          let*-macro]

src/makefile.ss

@@ -90,6 +90,7 @@
     [let               (macro . let)]
     [let*              (macro . let*)]
     [cond              (macro . cond)]
+    [do                (macro . do)]
     [and               (macro . and)]
     [or                (macro . or)]))
 
@@ -149,6 +150,7 @@
     [let              i r]
     [let*             i r]
     [cond             i r]
+    [do               i r]
     [and              i r]
     [or               i r]))
 
@@ -370,6 +372,7 @@
     [values                  i r]
     [call-with-values        i r]
     [call/cc                 i r]
+    [call-with-current-continuation i r]
     [call/cf                 i]
     [dynamic-wind            i r]
     [error                   i]