[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 15/99: Handle case-lambda via a jump table
From: |
Christopher Allan Webber |
Subject: |
[Guile-commits] 15/99: Handle case-lambda via a jump table |
Date: |
Sun, 10 Oct 2021 21:50:44 -0400 (EDT) |
cwebber pushed a commit to branch compile-to-js-merge
in repository guile.
commit 44e04eae0a193a63cf6057df6980056879f6622d
Author: Ian Price <ianprice90@googlemail.com>
AuthorDate: Tue Jun 9 17:08:09 2015 +0100
Handle case-lambda via a jump table
---
module/language/cps/compile-js.scm | 58 ++++++++++++++++++----------
module/language/js-il.scm | 12 +++++-
module/language/js-il/compile-javascript.scm | 55 +++++++++++++++++++++++---
3 files changed, 97 insertions(+), 28 deletions(-)
diff --git a/module/language/cps/compile-js.scm
b/module/language/cps/compile-js.scm
index 826f646..dd7241d 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -30,29 +30,47 @@
(define (compile-fun fun)
(match fun
- (($ $cont k ($ $kfun src meta self ($ $cont tail ($ $ktail)) clause))
- (make-var k (compile-clause clause self tail)))))
+ (($ $cont k ($ $kfun _ _ self ($ $cont tail ($ $ktail)) clause))
+ (call-with-values
+ (lambda ()
+ (extract-clauses self clause))
+ (lambda (jump-table clauses)
+ (make-var
+ k
+ (make-function
+ (list self tail)
+ (make-local (map (lambda (clause)
+ (compile-clause clause self tail))
+ clauses)
+ (make-jump-table jump-table)))))))))
+
+(define (extract-clauses self clause)
+ (let loop ((clause clause) (specs '()) (clauses '()))
+ (match clause
+ (($ $cont k ($ $kclause ($ $arity req _ rest _ _) _ #f))
+ (values (reverse (cons (cons (make-params self req rest) k) specs))
+ (reverse (cons clause clauses))))
+ (($ $cont k ($ $kclause ($ $arity req _ rest _ _) _ alternate))
+ (loop alternate
+ (cons (cons (make-params self req rest) k) specs)
+ (cons clause clauses))))))
(define (compile-clause clause self tail)
(match clause
- (($ $cont k ($ $kclause ($ $arity req opt rest kw allow-other-keys?)
- body alternate))
- ;; add function argument prelude
- (unless (null? opt)
- (not-supported "optional arguments are not supported" clause))
- (unless (or (null? kw) allow-other-keys?)
- (not-supported "keyword arguments are not supported" clause))
- (when alternate
- (not-supported "alternate continuations are not supported" clause))
- (make-function (make-params self (cons tail req) rest)
- (match body
- (($ $cont k ($ $kargs () () exp))
- (compile-term exp))
- (($ $cont k _)
- (make-local (list (compile-cont body))
- (make-continue
- k
- (map make-id (append req (if rest (list
rest) '())))))))))))
+ (($ $cont k ($ $kclause ($ $arity req _ rest _) body _))
+ (make-var
+ k
+ (make-continuation
+ (append (list self)
+ req (if rest (list rest) '()))
+ (match body
+ (($ $cont k ($ $kargs () () exp))
+ (compile-term exp))
+ (($ $cont k _)
+ (make-local (list (compile-cont body))
+ (make-continue
+ k
+ (map make-id (append req (if rest (list rest)
'()))))))))))))
(define (not-supported msg clause)
(error 'not-supported msg clause))
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 4c6c346..943590e 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -4,6 +4,7 @@
#:use-module (ice-9 match)
#:export (make-program program
make-function function
+ make-jump-table jump-table
make-params params
make-continuation continuation
make-local local
@@ -50,6 +51,7 @@
(define-js-type program entry body)
(define-js-type function params body)
+(define-js-type jump-table spec)
(define-js-type params self req rest)
(define-js-type continuation params body)
(define-js-type local bindings body) ; local scope
@@ -69,8 +71,14 @@
`(program ,(unparse-js entry) . ,(map unparse-js body)))
(($ continuation params body)
`(continuation ,params ,(unparse-js body)))
- (($ function ($ params self req opt) body)
- `(function ,(append (list self) req (if opt (list opt) '())) ,(unparse-js
body)))
+ (($ function args body)
+ `(function ,args ,(unparse-js body)))
+ (($ jump-table body)
+ `(jump-table ,@(map (lambda (p)
+ `(,(unparse-js (car p)) . ,(cdr p)))
+ body)))
+ (($ params self req rest)
+ `(params ,self ,req ,rest))
(($ local bindings body)
`(local ,(map unparse-js bindings) ,(unparse-js body)))
(($ var id exp)
diff --git a/module/language/js-il/compile-javascript.scm
b/module/language/js-il/compile-javascript.scm
index 19e8eb7..3c9385b 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -1,4 +1,5 @@
(define-module (language js-il compile-javascript)
+ #:use-module ((srfi srfi-1) #:select (fold-right))
#:use-module (ice-9 match)
#:use-module ((language js-il) #:renamer (symbol-prefix-proc 'il:))
#:use-module (language javascript)
@@ -81,13 +82,11 @@
(($ il:continuation params body)
(make-function (map rename params) (list (compile-exp body))))
- (($ il:function ($ il:params self req #f) body)
- (make-function (map rename (cons self req)) (list (compile-exp body))))
+ (($ il:function params body)
+ (make-function (map rename params) (list (compile-exp body))))
- (($ il:function ($ il:params self req rest) body)
- (make-function (map rename (cons self req))
- (list (bind-rest-args rest (length (cons self req)))
- (compile-exp body))))
+ (($ il:jump-table specs)
+ (compile-jump-table specs))
(($ il:local bindings body)
(make-block (append (map compile-exp bindings) (list (compile-exp
body)))))
@@ -125,6 +124,50 @@
(($ il:id name)
(name->id name))))
+(define (compile-jump-table specs)
+ (define offset 2) ; closure & continuation
+ (define (compile-test params)
+ (match params
+ (($ il:params self req #f)
+ (make-binop '=
+ (make-refine (make-id "arguments")
+ (make-const "length"))
+ (make-const (+ offset (length req)))))
+ (($ il:params self req rest)
+ (make-binop '>=
+ (make-refine (make-id "arguments")
+ (make-const "length"))
+ (make-const (+ offset (length req)))))))
+ (define (compile-jump params k)
+ (match params
+ (($ il:params self req #f)
+ (list
+ (make-return
+ (make-call (name->id k)
+ (cons (name->id self)
+ (map (lambda (idx)
+ (make-refine (make-id "arguments")
+ (make-const (+ offset idx))))
+ (iota (length req))))))))
+ (($ il:params self req rest)
+ (list
+ (bind-rest-args rest (+ offset (length req)))
+ (make-return
+ (make-call (name->id k)
+ (append (list (name->id self))
+ (map (lambda (idx)
+ (make-refine (make-id "arguments")
+ (make-const (+ offset idx))))
+ (iota (length req)))
+ (list (name->id rest)))))))))
+ (fold-right (lambda (a d)
+ (make-branch (compile-test (car a))
+ (compile-jump (car a) (cdr a))
+ (list d)))
+ ;; FIXME: should throw an error
+ (make-return (make-id "undefined"))
+ specs))
+
(define (compile-const c)
(cond ((number? c)
(make-const c))
- [Guile-commits] 05/99: separate js-il functions into actual functions and those for continuations, (continued)
- [Guile-commits] 05/99: separate js-il functions into actual functions and those for continuations, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 06/99: Get rid of comments and dead branches, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 07/99: Simple inlining of immediate calls, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 08/99: conditional->branch, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 10/99: fix makefile, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 11/99: Compile rest args, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 16/99: Remove superfluous space, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 20/99: Implement keyword argument parsing, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 12/99: Compile string constants, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 13/99: Mangle js identifiers, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 15/99: Handle case-lambda via a jump table,
Christopher Allan Webber <=
- [Guile-commits] 19/99: Simplify output Javascript, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 21/99: Primitives should return Scheme Booleans, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 23/99: Compile cps $prompt form to javascript, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 26/99: abort-to-prompt takes multiple arguments, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 34/99: Change function type representation, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 33/99: Change program type representation, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 31/99: Different types for Continuation and Variable identifiers, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 29/99: Use scheme.frame.Prompt objects for prompts on dynstack, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 30/99: Implement fluid primitives, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 36/99: Handle more identifier characters, Christopher Allan Webber, 2021/10/10