Removing call-with-values for now

cyclone.scm

@@ -151,17 +151,22 @@
                    input-program)))
         (cond
          ((and library? (equal? lib-name '(scheme base)))
-           (set! globals (append '(call-with-values call/cc) globals))
-           (set! module-globals (append '(call-with-values call/cc) module-globals))
+           (set! globals (append '(call/cc) globals))
+           (set! module-globals (append '(call/cc) module-globals))
            (set! input-program 
-             (cons
-              ;; Experimental version of call-with-values,
-              ;; seems OK in compiler but not in eval.
-              '(define call-with-values
-                (lambda (k producer consumer)
-                  (producer 
-                    (lambda (result)
-                      (consumer k result)))))
+             ;(cons
+             ; ;; Experimental version of call-with-values,
+             ; ;; seems OK in compiler but not in eval.
+             ; '(define call-with-values
+             ;   (lambda (k producer consumer)
+             ;     (let ((x (producer)))
+             ;       (if (and (pair? x) (equal? '(multiple values) (car x)))
+             ;         (apply consumer (cdr x))
+             ;         (consumer k x))))
+             ;   ;  (producer 
+             ;   ;    (lambda (result)
+             ;   ;      (consumer k result))))
+             ;   )
                     ;; multiple args requires more than just this.
                     ;; may want to look at:
                     ;; http://stackoverflow.com/questions/16674214/how-to-implement-call-with-values-to-match-the-values-example-in-r5rs
@@ -173,7 +178,7 @@
                ;; TODO: will this cause issues if another var is assigned to call/cc?
                '(define call/cc
                  (lambda (k f) (f k (lambda (_ result) (k result)))))
-                cps))))
+                cps)));)
          (else
            ;; No need for call/cc yet
            (set! input-program cps))))

scheme/base.sld

@@ -314,19 +314,36 @@
     ;; TODO: The whitespace characters are space, tab, line feed, form feed (not in parser yet), and carriage return.
     (define call-with-current-continuation call/cc)
     ;; TODO: this is from r7rs, but is not really good enough by itself
-    (define (values . things)
-      (call/cc
-        (lambda (cont) (apply cont things))))
+    ;(define (values . things)
+    ;  (call/cc
+    ;    (lambda (cont) (apply cont things))))
+    (define values 
+      (lambda args
+        (if (and (not (null? args)) (null? (cdr args)))
+            (car args)
+            (cons (cons 'multiple 'values) args)))) 
     ;; TODO: just need something good enough for bootstrapping (for now)
     ;; does not have to be perfect (this is not, does not handle call/cc or exceptions)
+;    (define call-with-values
+;      (lambda (producer consumer)
+;        (let ((x (producer)))
+;          (if ;(magic? x)
+;              (and (pair? x) (equal? (car x) (cons 'multiple 'values)))
+;              (apply consumer (cdr x))
+;              (consumer x)))))
+
     (define (dynamic-wind before thunk after)
       (before)
-      (call-with-values
-        thunk
-        (lambda (result) ;results
-          (after)
-          result)))
+      (let ((result (thunk)))
+        (after)
+        result)
+      ;(call-with-values
+      ;  thunk
+      ;  (lambda (result) ;results
+      ;    (after)
+      ;    result)))
           ;(apply values results))))
+    )
     (define (call-with-port port proc)
       (let ((result (proc port)))
         (close-port port)

scheme/cyclone/transforms.sld

@@ -136,7 +136,7 @@
 (define *defined-macros* (list))
 
 (define (built-in-syms)
-  '(call-with-values call/cc define))
+  '(call/cc define))
 
 ;; Tuning
 (define *do-code-gen* #t) ; Generate C code?

scheme/eval.sld

@@ -131,7 +131,6 @@
 (define primitive-procedures
   (list 
       (list 'call/cc call/cc)
-      (list 'call-with-values call-with-values)
       (list 'Cyc-global-vars Cyc-global-vars)
       (list 'Cyc-get-cvar Cyc-get-cvar)
       (list 'Cyc-set-cvar! Cyc-set-cvar!)