[Guile-commits] 02/99: Replace values object with values passed as continuation arguments

[Christopher Allan Webber]

cwebber pushed a commit to branch compile-to-js-merge
in repository guile.

commit d57dc85fa84a380c3deefff098069fcab90d7f2d
Author: Ian Price <ianprice90@googlemail.com>
AuthorDate: Sat Jun 6 10:14:36 2015 +0100

    Replace values object with values passed as continuation arguments
---
 module/language/cps/compile-js.scm           | 19 ++++++++-----------
 module/language/js-il.scm                    | 12 ++++--------
 module/language/js-il/compile-javascript.scm |  9 ++-------
 module/language/js-il/runtime.js             | 14 +++-----------
 4 files changed, 17 insertions(+), 37 deletions(-)

diff --git a/module/language/cps/compile-js.scm 
b/module/language/cps/compile-js.scm
index ed75db0..0e0aa4e 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -1,5 +1,4 @@
 (define-module (language cps compile-js)
-  #:use-module ((guile) #:select ((values . mv:values))) ;; FIXME:
   #:use-module (language cps)
   #:use-module (language js-il)
   #:use-module (ice-9 match)
@@ -25,7 +24,7 @@
      ;; "self" argument, for now, I add "undefined" as the first
      ;; argument in the call to it.
      ;; see compile-exp in (language js-il compile-javascript)
-     (mv:values (make-program (compile-fun (car funs))
+     (values (make-program (compile-fun (car funs))
                            (map compile-fun (cdr funs)))
              env
              env)))
@@ -79,8 +78,6 @@
      ;; use the name part?
      (make-var k (make-function syms (compile-term body))))
     (($ $cont k ($ $kreceive ($ $arity (arg) _ (? symbol? rest) _ _) k2))
-     ;; still not 100% on passing values as args vs a values object.
-     ;; using the former means I can merge make-jscall and make-continue
      (make-var k (make-function (list arg rest) (make-jscall k2 (list arg 
rest)))))
     (($ $cont k ($ $kreceive ($ $arity (arg) _ #f _ _) k2))
      (make-var k (make-function (list arg) (make-jscall k2 (list arg)))))
@@ -93,15 +90,17 @@
     (($ $branch kt exp)
      (compile-test exp kt k))
     (($ $primcall 'return (arg))
-     (make-continue k (make-id arg)))
+     (make-continue k (list (make-id arg))))
     (($ $call name args)
      (make-call name (cons k args)))
     (($ $callk label proc args)
      ;; eh?
      ;; (pk 'callk label proc args k)
-     (make-jscall label (cons k args)))
+     (make-jscall label (cons* proc k args)))
+    (($ $values values)
+     (make-continue k (map make-id values)))
     (_
-     (make-continue k (compile-exp* exp)))))
+     (make-continue k (list (compile-exp* exp))))))
 
 (define (compile-exp* exp)
   (match exp
@@ -111,8 +110,6 @@
      (make-primcall name args))
     (($ $closure label nfree)
      (make-closure label nfree))
-    (($ $values values)
-     (make-values values))
     (_
      `(exp:todo: ,exp))))
 
@@ -121,5 +118,5 @@
   ;; don't need to create a new continuation (which will require extra
   ;; arguments being passed through)
   (make-branch (compile-exp* exp)
-               (make-continue kt (make-values '()))
-               (make-continue kf (make-values '()))))
+               (make-continue kt '())
+               (make-continue kf '())))
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index b62c3ba..7dceb60 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -13,7 +13,6 @@
             make-jscall jscall
             make-closure closure
             make-branch branch
-            make-values values
             ; print-js
             make-return return
             make-id id
@@ -61,13 +60,12 @@
 
 (define-js-type local bindings body) ; local scope
 (define-js-type var id exp)
-(define-js-type continue cont exp)
+(define-js-type continue cont args)
 (define-js-type const value)
 (define-js-type primcall name args)
 (define-js-type call name args)
 (define-js-type jscall name args) ;; TODO: shouldn't need this hack
 (define-js-type closure label num-free)
-(define-js-type values vals)
 (define-js-type branch test consequence alternate)
 (define-js-type id name)
 (define-js-type return val)
@@ -82,8 +80,8 @@
      `(local ,(map unparse-js bindings) ,(unparse-js body)))
     (($ var id exp)
      `(var ,id ,(unparse-js exp)))
-    (($ continue k exp)
-     `(continue ,k ,(unparse-js exp)))
+    (($ continue k args)
+     `(continue ,k ,(map unparse-js args)))
     (($ branch test then else)
      `(if ,(unparse-js test) ,(unparse-js then) ,(unparse-js else)))
     ;; values
@@ -97,8 +95,6 @@
      `(jscall ,name , args))
     (($ closure label nfree)
      `(closure ,label ,nfree))
-    (($ values vals)
-     `(values . ,vals))
     (($ return val)
      `(return . ,(unparse-js val)))
     (($ id name)
@@ -141,7 +137,7 @@
     (($ var id exp)
      (format port "var ~a = " (lookup-cont id))
      (print-js exp port))
-    (($ continue k exp)
+    (($ continue k args)
      (format port "return ~a(" (lookup-cont k))
      (print-js exp port)
      (display ")" port))
diff --git a/module/language/js-il/compile-javascript.scm 
b/module/language/js-il/compile-javascript.scm
index 21b6fc9..6fde3ba 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -42,8 +42,8 @@
     (($ il:var id exp)
      (make-var (rename id) (compile-exp exp)))
 
-    (($ il:continue k exp)
-     (make-return (make-call (name->id k) (list (compile-exp exp)))))
+    (($ il:continue k exps)
+     (make-return (make-call (name->id k) (map compile-exp exps))))
 
     (($ il:branch test then else)
      (make-conditional (make-call (make-refine *scheme* (make-const "is_true"))
@@ -72,11 +72,6 @@
       (make-call (make-refine *scheme* (make-const "Closure"))
                  (list (name->id label) (make-const nfree)))))
 
-    (($ il:values vals)
-     (make-new
-      (make-call (make-refine *scheme* (make-const "Values"))
-                 (map name->id vals))))
-
     (($ il:id name)
      (name->id name))))
 
diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 823ba97..502c61b 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -159,12 +159,6 @@ scheme.primitives["resolve"] = function (sym, is_bound) {
     return scheme.env[sym.name];
 };
 
-// values
-scheme.Values = function () {
-    this.values = arguments;
-    return this;
-};
-
 // bleh
 scheme.initial_cont = function (x) { return x; };
 scheme.primitives.return = function (x) { return x; };
@@ -172,13 +166,11 @@ scheme.is_true = function (obj) {
     return !(obj == scheme.FALSE || obj == scheme.NIL);
 };
 
-var callcc = function (k,vals) {
-    var closure = vals.values[0];
-    var f = function (k2, val) {
-        // TODO: multivalue continuations
+var callcc = function (self, k, closure) {
+    var f = function (self, k2, val) {
         return k(val);
     };
-    return closure.fun(k, new scheme.Closure(f, 0));
+    return closure.fun(closure, k, new scheme.Closure(f, 0));
 };
 scheme.builtins[4] = new scheme.Closure(callcc, 0);
 // #define FOR_EACH_VM_BUILTIN(M) \