diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm index ed75db0a2..0e0aa4ecd 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 b62c3bad4..7dceb6061 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 21b6fc9c6..6fde3bae0 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 823ba9706..502c61b57 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) \