[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 32/99: Rewrite js-il inliner
From: |
Christopher Allan Webber |
Subject: |
[Guile-commits] 32/99: Rewrite js-il inliner |
Date: |
Sun, 10 Oct 2021 21:50:50 -0400 (EDT) |
cwebber pushed a commit to branch compile-to-js-merge
in repository guile.
commit f0537e39ee9b1f96eb073ee11f4dac2c0c66e67e
Author: Ian Price <ianprice90@googlemail.com>
AuthorDate: Sat Jun 20 20:58:29 2015 +0100
Rewrite js-il inliner
---
module/Makefile.am | 2 +-
module/language/js-il/compile-javascript.scm | 4 +-
module/language/js-il/direct.scm | 36 -----
module/language/js-il/inlining.scm | 205 +++++++++++++++++++++++++++
4 files changed, 208 insertions(+), 39 deletions(-)
diff --git a/module/Makefile.am b/module/Makefile.am
index 7a9e715..f16d6b4 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -209,7 +209,7 @@ BRAINFUCK_LANG_SOURCES = \
JS_IL_LANG_SOURCES = \
language/js-il.scm \
- language/js-il/direct.scm \
+ language/js-il/inlining.scm \
language/js-il/compile-javascript.scm \
language/js-il/spec.scm
diff --git a/module/language/js-il/compile-javascript.scm
b/module/language/js-il/compile-javascript.scm
index d269ab6..44384c6 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -4,7 +4,7 @@
#:use-module ((language js-il) #:renamer (symbol-prefix-proc 'il:))
#:use-module (language javascript)
#:use-module (language javascript simplify)
- #:use-module (language js-il direct)
+ #:use-module (language js-il inlining)
#:use-module (system foreign)
#:export (compile-javascript))
@@ -15,7 +15,7 @@
(eqv? obj (pointer->scm (make-pointer unbound-bits))))
(define (compile-javascript exp env opts)
- (set! exp (remove-immediate-calls exp))
+ (set! exp (inline-single-calls exp))
(set! exp (compile-exp exp))
(set! exp (flatten-blocks exp))
(values exp env env))
diff --git a/module/language/js-il/direct.scm b/module/language/js-il/direct.scm
deleted file mode 100644
index 589e765..0000000
--- a/module/language/js-il/direct.scm
+++ /dev/null
@@ -1,36 +0,0 @@
-(define-module (language js-il direct)
- #:use-module (ice-9 match)
- #:use-module (language js-il)
- #:export (remove-immediate-calls))
-
-(define (remove-immediate-calls exp)
- (match exp
- (($ program entry body)
- (make-program (remove-immediate-calls entry)
- (map remove-immediate-calls body)))
-
- (($ continuation params body)
- (make-continuation params (remove-immediate-calls body)))
-
- (($ function self tail body)
- (make-function self tail (remove-immediate-calls body)))
-
- (($ local
- (($ var id ($ continuation () body)))
- ($ continue id ()))
- (remove-immediate-calls body))
-
- (($ local
- (($ var id ($ continuation (arg) body)))
- ($ continue id (val)))
- (make-local (list (make-var arg val))
- (remove-immediate-calls body)))
-
- (($ local bindings body)
- (make-local (map remove-immediate-calls bindings)
- (remove-immediate-calls body)))
-
- (($ var id exp)
- (make-var id (remove-immediate-calls exp)))
-
- (exp exp)))
diff --git a/module/language/js-il/inlining.scm
b/module/language/js-il/inlining.scm
new file mode 100644
index 0000000..f042966
--- /dev/null
+++ b/module/language/js-il/inlining.scm
@@ -0,0 +1,205 @@
+(define-module (language js-il inlining)
+ #:use-module ((srfi srfi-1) #:select (partition))
+ #:use-module (ice-9 match)
+ #:use-module (language js-il)
+ #:export (count-calls
+ inline-single-calls
+ ))
+
+(define (count-calls exp)
+ (define counts (make-hash-table))
+ (define (count-inc! key)
+ (hashv-set! counts key (+ 1 (hashv-ref counts key 0))))
+ (define (count-inf! key)
+ (hashv-set! counts key +inf.0))
+ (define (analyse-args arg-list)
+ (for-each (match-lambda
+ (($ kid name)
+ (count-inf! name))
+ (($ id name) #f))
+ arg-list))
+ (define (analyse exp)
+ (match exp
+ (($ program entry body)
+ (analyse entry)
+ (for-each analyse body))
+
+ (($ function self tail body)
+ (analyse body))
+
+ (($ jump-table spec)
+ (for-each (lambda (p) (analyse (cdr p)))
+ spec))
+
+ (($ continuation params body)
+ (analyse body))
+
+ (($ local bindings body)
+ (for-each analyse bindings)
+ (analyse body))
+
+ (($ var id exp)
+ (analyse exp))
+
+ (($ continue ($ kid cont) args)
+ (count-inc! cont)
+ (for-each analyse args))
+
+ (($ primcall name args)
+ (analyse-args args))
+
+ (($ call name ($ kid k) args)
+ (count-inf! k)
+ (analyse-args args))
+
+ (($ closure ($ kid label) num-free)
+ (count-inf! label))
+
+ (($ branch test consequence alternate)
+ (analyse test)
+ (analyse consequence)
+ (analyse alternate))
+
+ (($ kid name)
+ (count-inf! name))
+
+ (($ seq body)
+ (for-each analyse body))
+
+ (($ prompt escape? tag ($ kid handler))
+ (count-inf! handler))
+
+ (else #f)))
+ (analyse exp)
+ counts)
+
+(define no-values-primitives
+ '(define!
+ cache-current-module!
+ set-cdr!
+ set-car!
+ vector-set!
+ free-set!
+ vector-set!/immediate
+ box-set!
+ struct-set!
+ struct-set!/immediate
+ wind
+ unwind
+ push-fluid
+ pop-fluid
+ ))
+
+(define no-values-primitive?
+ (let ((h (make-hash-table)))
+ (for-each (lambda (prim)
+ (hashv-set! h prim #t))
+ no-values-primitives)
+ (lambda (prim)
+ (hashv-ref h prim))))
+
+(define (inline-single-calls exp)
+
+ (define calls (count-calls exp))
+
+ (define (inlinable? k)
+ (eqv? 1 (hashv-ref calls k)))
+
+ (define (split-inlinable bindings)
+ (partition (match-lambda
+ (($ var ($ kid id) _) (inlinable? id)))
+ bindings))
+
+ (define (lookup kont substs)
+ (match substs
+ ((($ var ($ kid id) exp) . rest)
+ (if (= id kont)
+ exp
+ (lookup kont rest)))
+ (() kont)
+ (else
+ (throw 'lookup-failed kont))))
+
+ (define (inline exp substs)
+ (match exp
+
+ ;; FIXME: This hacks around the fact that define doesn't return
+ ;; arguments to the continuation. This should be handled when
+ ;; converting to js-il, not here.
+ (($ continue
+ ($ kid (? inlinable? cont))
+ (($ primcall (? no-values-primitive? prim) args)))
+ (match (lookup cont substs)
+ (($ continuation () body)
+ (make-seq
+ (list
+ (make-primcall prim args)
+ (inline body substs))))
+ (else
+ ;; inlinable but not locally bound
+ exp)))
+
+ (($ continue ($ kid (? inlinable? cont)) args)
+ (match (lookup cont substs)
+ (($ continuation kargs body)
+ (if (not (= (length args) (length kargs)))
+ (throw 'args-dont-match cont args kargs)
+ (make-local (map make-var kargs args)
+ ;; gah, this doesn't work
+ ;; identifiers need to be separated earlier
+ ;; not just as part of compilation
+ (inline body substs))))
+ (else
+ ;; inlinable but not locally bound
+ ;; FIXME: This handles tail continuations, but only by accident
+ exp)))
+
+ (($ continue cont args)
+ exp)
+
+ (($ continuation params body)
+ (make-continuation params (inline body substs)))
+
+ (($ local bindings body)
+ (call-with-values
+ (lambda ()
+ (split-inlinable bindings))
+ (lambda (new-substs uninlinable-bindings)
+ (define substs* (append new-substs substs))
+ (make-local (map (lambda (x) (inline x substs*))
+ uninlinable-bindings)
+ (inline body substs*)))))
+
+ (($ var id exp)
+ (make-var id (inline exp substs)))
+
+ (($ seq body)
+ (make-seq (map (lambda (x) (inline x substs))
+ body)))
+
+ (($ branch test consequence alternate)
+ (make-branch test
+ (inline consequence substs)
+ (inline alternate substs)))
+
+ (exp exp)))
+
+ (define (handle-function fun)
+ (define (handle-bindings bindings)
+ (map (lambda (binding)
+ (match binding
+ (($ var id ($ continuation params body))
+ (make-var id (make-continuation params (inline body '()))))))
+ bindings))
+ (match fun
+ (($ var id ($ function self tail ($ local bindings ($ jump-table spec))))
+ (make-var id
+ (make-function self
+ tail
+ (make-local (handle-bindings bindings)
+ (make-jump-table spec)))))))
+
+ (match exp
+ (($ program entry body)
+ (make-program (handle-function entry)
+ (map handle-function body)))))
- [Guile-commits] 65/99: Implement module built-ins., (continued)
- [Guile-commits] 65/99: Implement module built-ins., Christopher Allan Webber, 2021/10/10
- [Guile-commits] 72/99: Implement basic `equal?' implementation, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 68/99: struct-set! primitive returns no values, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 71/99: modules should be passed current continuation, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 79/99: Implement list builtins, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 80/99: *features* is an empty list, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 84/99: Add assignment js-type to (language javascript), Christopher Allan Webber, 2021/10/10
- [Guile-commits] 87/99: Create stub module forms for dependecies, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 97/99: Switch use of $closure to $const-fun, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 22/99: Add more Scheme Primitives to runtime.js, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 32/99: Rewrite js-il inliner,
Christopher Allan Webber <=
- [Guile-commits] 82/99: pop-fluid uses field of frame not fluid, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 85/99: Handle more JavaScript binary operators, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 86/99: Keywords cannot be both keyword and optional, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 91/99: Update Copyright Headers, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 94/99: Add compiler-chooser for CPS spec, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 96/99: Fix cps's choose-compiler to be able to compile javascript, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 98/99: Merge branch 'main' into compile-to-js-merge, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 78/99: Implement Hook Builtins, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 81/99: Argument to make-fluid is optional, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 83/99: Implement variable-bound? builtin, Christopher Allan Webber, 2021/10/10