[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 42/99: compile-js uses the new cps representation
From: |
Christopher Allan Webber |
Subject: |
[Guile-commits] 42/99: compile-js uses the new cps representation |
Date: |
Sun, 10 Oct 2021 21:50:55 -0400 (EDT) |
cwebber pushed a commit to branch compile-to-js-merge
in repository guile.
commit 0e4fb0920f8108e1005a4cb8696b689b239ccb0d
Author: Ian Price <ianprice90@googlemail.com>
AuthorDate: Wed Jun 14 23:07:40 2017 +0100
compile-js uses the new cps representation
* module/language/cps/compile-js.scm: Rewrite to use cps
---
module/language/cps/compile-js.scm | 89 ++++++++++++++++++--------------------
1 file changed, 41 insertions(+), 48 deletions(-)
diff --git a/module/language/cps/compile-js.scm
b/module/language/cps/compile-js.scm
index ddfe88c..03e9e7d 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -1,48 +1,52 @@
(define-module (language cps compile-js)
#:use-module (language cps)
+ #:use-module (language cps intmap)
+ #:use-module (language cps utils)
#:use-module ((language js-il)
#:renamer (lambda (x) (if (eqv? x 'make-prompt) 'make-prompt*
x)))
#:use-module (ice-9 match)
#:export (compile-js))
+(define intmap-select (@@ (language cps compile-bytecode) intmap-select))
(define lower-cps (@@ (language cps compile-bytecode) lower-cps))
(define (compile-js exp env opts)
- (set! exp (lower-cps exp opts))
- (match exp
- (($ $program (($ $cont ks funs) ...))
- ;; TODO: I should special case the compilation for the initial fun,
- ;; as this is the entry point for the program, and shouldn't get a
- ;; "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)
- (values (make-program
- (map (lambda (k fun)
- (cons (make-kid k) (compile-fun fun)))
- ks
- funs))
- env
- env))))
+ ;; TODO: I should special case the compilation for the initial fun,
+ ;; as this is the entry point for the program, and shouldn't get a
+ ;; "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)
+ (define (intmap->program map)
+ (intmap-fold-right (lambda (kfun body accum)
+ (acons (make-kid kfun)
+ (compile-fun (intmap-select map body) kfun)
+ accum))
+ (compute-reachable-functions map 0)
+ '()))
+ (values (make-program (intmap->program (lower-cps exp opts))) env env))
+
-(define (compile-fun fun)
- (match fun
- (($ $kfun _ _ self ($ $cont tail ($ $ktail)) clause)
+(define (compile-fun cps kfun)
+ (match (intmap-ref cps kfun)
+ (($ $kfun src meta self tail clause)
(make-function
(make-id self)
(make-kid tail)
- (compile-clauses clause self)))))
+ (compile-clauses cps clause self)))))
+
-(define (compile-clauses clause self)
- (match clause
- (($ $cont k ($ $kclause arity body #f))
- `((,(make-kid k)
+(define (compile-clauses cps clause self)
+ (match (intmap-ref cps clause)
+ (($ $kclause arity body #f)
+ `((,(make-kid clause)
,(arity->params arity self)
- ,(compile-clause arity body self))))
- (($ $cont k ($ $kclause arity body next))
- `((,(make-kid k)
+ ,(compile-clause cps arity body self))))
+ (($ $kclause arity body next)
+ `((,(make-kid clause)
,(arity->params arity self)
- ,(compile-clause arity body self))
- . ,(compile-clauses next self)))))
+ ,(compile-clause cps arity body self))
+ . ,(compile-clauses cps next self)))))
+
(define (arity->params arity self)
(match arity
@@ -58,34 +62,23 @@
kw-syms)
allow-other-keys?))))
-(define (compile-clause arity body self)
+
+(define (compile-clause cps arity body self)
(match arity
(($ $arity req opt rest ((_ _ kw-syms) ...) _)
(let ((ids (map make-id
(append req opt kw-syms (if rest (list rest) '())))))
(make-continuation
(cons (make-id self) ids)
- (match body
- (($ $cont k cont)
- (make-local `((,(make-kid k) . ,(compile-cont cont)))
- (make-continue (make-kid k) ids)))))))))
+ (make-local `((,(make-kid body) . ,(compile-cont cps body)))
+ (make-continue (make-kid body) ids)))))))
-(define (compile-term term)
- (match term
- (($ $letk (($ $cont ks conts) ...) body)
- (make-local (map (lambda (k cont)
- (cons (make-kid k)
- (compile-cont cont)))
- ks
- conts)
- (compile-term body)))
- (($ $continue k src exp)
- (compile-exp exp k))))
-(define (compile-cont cont)
- (match cont
- (($ $kargs names syms body)
- (make-continuation (map make-id syms) (compile-term body)))
+(define (compile-cont cps cont)
+ (match (intmap-ref cps cont)
+ ;; The term in a $kargs is always a $continue
+ (($ $kargs names syms ($ $continue k src exp))
+ (make-continuation (map make-id syms) (compile-exp exp k)))
(($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2)
(let ((ids (map make-id (append req (list rest)))))
(make-continuation ids (make-continue (make-kid k2) ids))))
- [Guile-commits] 52/99: Add macro type in runtime.js, (continued)
- [Guile-commits] 52/99: Add macro type in runtime.js, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 51/99: Implement cached-module-box, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 48/99: Rebuild nested scopes for js continuations, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 18/99: Add more types of constants, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 17/99: Implement Optional arguments, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 27/99: values takes multiple arguments, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 28/99: Implement apply correctly, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 38/99: Explicitly test for undefined arguments to handle false values like 0, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 44/99: Update primitives in no-values-primitives, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 35/99: Change local type representation and remove var type, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 42/99: compile-js uses the new cps representation,
Christopher Allan Webber <=
- [Guile-commits] 43/99: Handle multiple conts in a function body, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 46/99: JS-IL inliner has different count-calls for different clauses, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 40/99: Merge branch 'stable-2.2' into compile-to-js-2017, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 49/99: Compile Syntax Objects to Javascript, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 39/99: Add missing simplify.scm to Makefile, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 37/99: Fixup binop unparsing, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 57/99: Implement built-in syntax procedures., Christopher Allan Webber, 2021/10/10
- [Guile-commits] 56/99: Implement builtin list procedures., Christopher Allan Webber, 2021/10/10
- [Guile-commits] 58/99: Implement built-in symbol procedures., Christopher Allan Webber, 2021/10/10
- [Guile-commits] 64/99: Implement procedure built-ins., Christopher Allan Webber, 2021/10/10