[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 05/99: separate js-il functions into actual functions an
From: |
Christopher Allan Webber |
Subject: |
[Guile-commits] 05/99: separate js-il functions into actual functions and those for continuations |
Date: |
Sun, 10 Oct 2021 21:50:41 -0400 (EDT) |
cwebber pushed a commit to branch compile-to-js-merge
in repository guile.
commit 54ce470cf870dd0c8bacd7d9b5bda2e0d24c36ea
Author: Ian Price <ianprice90@googlemail.com>
AuthorDate: Sat Jun 6 20:10:57 2015 +0100
separate js-il functions into actual functions and those for continuations
---
module/language/cps/compile-js.scm | 20 +++--
module/language/js-il.scm | 128 ++-------------------------
module/language/js-il/compile-javascript.scm | 3 +-
3 files changed, 20 insertions(+), 131 deletions(-)
diff --git a/module/language/cps/compile-js.scm
b/module/language/cps/compile-js.scm
index 6d1edb8..1d50c89 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -51,7 +51,7 @@
(not-supported "keyword arguments are not supported" clause))
(when alternate
(not-supported "alternate continuations are not supported" clause))
- (make-function self ;; didn't think this js pattern would come in handy
+ (make-function self
(cons tail req)
(match body
(($ $cont k ($ $kargs () () exp))
@@ -76,11 +76,14 @@
(match cont
(($ $cont k ($ $kargs names syms body))
;; use the name part?
- (make-var k (make-function syms (compile-term body))))
- (($ $cont k ($ $kreceive ($ $arity (arg) _ (? symbol? rest) _ _) k2))
- (make-var k (make-function (list arg rest) (make-continue k2 (list
(make-id arg) (make-id rest))))))
- (($ $cont k ($ $kreceive ($ $arity (arg) _ #f _ _) k2))
- (make-var k (make-function (list arg) (make-continue k2 (list (make-id
arg))))))
+ (make-var k (make-continuation syms (compile-term body))))
+ (($ $cont k ($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2))
+ (make-var k
+ (make-continuation (append req (list rest))
+ (make-continue k2
+ (append (map make-id req) (list
(make-id rest)))))))
+ (($ $cont k ($ $kreceive ($ $arity req _ #f _ _) k2))
+ (make-var k (make-continuation req (make-continue k2 (map make-id req)))))
(_
`(cont:todo: ,cont))
))
@@ -108,6 +111,11 @@
(make-primcall name args))
(($ $closure label nfree)
(make-closure label nfree))
+ (($ $values (val))
+ ;; FIXME:
+ ;; may happen if a test branch of a conditional compiles to values
+ ;; placeholder till I learn if multiple values could be returned.
+ (make-id val))
(_
`(exp:todo: ,exp))))
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 946a1c0..02a99d5 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -3,7 +3,8 @@
#:use-module (srfi srfi-9 gnu)
#:use-module (ice-9 match)
#:export (make-program program
- (make-function* . make-function) function
+ make-function function
+ make-continuation continuation
make-local local
make-var var
make-continue continue ; differ from conts
@@ -49,14 +50,7 @@
(define-js-type program entry body)
(define-js-type function name params body)
-
-(define make-function*
- (case-lambda
- ((name params body)
- (make-function name params body))
- ((params body)
- (make-function #f params body))))
-
+(define-js-type continuation params body)
(define-js-type local bindings body) ; local scope
(define-js-type var id exp)
(define-js-type continue cont args)
@@ -72,6 +66,8 @@
(match exp
(($ program entry body)
`(program ,(unparse-js entry) . ,(map unparse-js body)))
+ (($ continuation params body)
+ `(continuation ,params ,(unparse-js body)))
(($ function name params body)
`(function ,name ,params ,(unparse-js body)))
(($ local bindings body)
@@ -99,117 +95,3 @@
;(error "unexpected js" exp)
(pk 'unexpected exp)
exp)))
-#|
-(define (print-js exp port)
- ;; could be much nicer with foof's fmt
- (match exp
- (($ program (and entry ($ var name _)) body)
- ;; TODO: I should probably put call to entry in js-il
- (format port "(function(){\n")
- (print-js entry port) (display ";\n" port)
- (print-terminated body print-js ";\n" port)
- ;; call to entry point
- (format port "return ~a(scheme.initial_cont);" (lookup-cont name))
- (format port "})();\n"))
- (($ function #f params body)
- (format port "function(")
- (print-separated params print-var "," port)
- (format port "){\n")
- (print-js body port)(display ";" port)
- (format port "}"))
- ;; TODO: clean this code up
- (($ function name params body)
- (format port "function (~a," (lookup-cont name))
- (print-separated params print-var "," port)
- (format port "){\n")
- (print-js body port)(display ";" port)
- (format port "}"))
- (($ local bindings body)
- (display "{" port)
- (print-terminated bindings print-js ";\n" port)
- (print-js body port)
- (display ";\n")
- (display "}" port))
- (($ var id exp)
- (format port "var ~a = " (lookup-cont id))
- (print-js exp port))
- (($ continue k args)
- (format port "return ~a(" (lookup-cont k))
- (print-js exp port)
- (display ")" port))
- (($ branch test then else)
- (display "if (scheme.is_true(" port)
- (print-js test port)
- (display ")) {\n" port)
- (print-js then port)
- (display ";} else {\n" port)
- (print-js else port)
- (display ";}" port))
- ;; values
- (($ const c)
- (print-const c port))
- (($ primcall name args)
- (format port "scheme.primitives[\"~s\"](" name)
- (print-separated args print-var "," port)
- (format port ")"))
- (($ call name args)
- ;; TODO: need to also add closure env
- (format port "return ~a.fun(~a," (lookup-cont name) (lookup-cont name))
- (print-separated args print-var "," port)
- (format port ")"))
- (($ jscall name args)
- (format port "return ~a(" (lookup-cont name))
- (print-separated args print-var "," port)
- (format port ")"))
- (($ closure label nfree)
- (format port "new scheme.Closure(~a,~a)" (lookup-cont label) nfree))
- (($ values vals)
- (display "new scheme.Values(" port)
- (print-separated vals print-var "," port)
- (display ")" port))
- ;; (($ return val)
- ;; (display "return " port)
- ;; (print-js val port))
- (($ id name)
- (print-var name port))
- (_
- (error "print: unexpected js" exp))))
-
-(define (print-var var port)
- (if (number? var)
- (display (lookup-cont var) port)
- (display var port)))
-
-(define (lookup-cont k)
- (format #f "kont_~s" k))
-
-(define (print-separated args printer separator port)
- (unless (null? args)
- (let ((first (car args))
- (rest (cdr args)))
- (printer first port)
- (for-each (lambda (x)
- (display separator port)
- (printer x port))
- rest))))
-
-(define (print-terminated args printer terminator port)
- (for-each (lambda (x)
- (printer x port)
- (display terminator port))
- args))
-
-(define (print-const c port)
- (cond ((number? c) (display c port))
- ((eqv? c #t) (display "scheme.TRUE" port))
- ((eqv? c #f) (display "scheme.FALSE" port))
- ((eqv? c '()) (display "scheme.EMPTY" port))
- ((unspecified? c) (display "scheme.UNSPECIFIED" port))
- ((symbol? c) (format port "new scheme.Symbol(\"~s\")" c))
- ((list? c)
- (display "scheme.list(" port)
- (print-separated c print-const "," port)
- (display ")" port))
- (else
- (throw 'not-implemented))))
-|#
diff --git a/module/language/js-il/compile-javascript.scm
b/module/language/js-il/compile-javascript.scm
index 790ac7c..fb5ed5e 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -29,11 +29,10 @@
(list (compile-exp entry)
entry-call)))
'())))
- (($ il:function #f params body)
+ (($ il:continuation params body)
(make-function (map rename params) (list (compile-exp body))))
(($ il:function name params body)
- ;; TODO: split il:function into closure (with self) and cont types
(make-function (map rename (cons name params)) (list (compile-exp body))))
(($ il:local bindings body)
- [Guile-commits] branch compile-to-js-merge created (now 6f112d5), Christopher Allan Webber, 2021/10/10
- [Guile-commits] 02/99: Replace values object with values passed as continuation arguments, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 01/99: Temp commit, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 09/99: get rid of unused match case, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 03/99: Remove jscall type, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 04/99: fix makefile, Christopher Allan Webber, 2021/10/10
- [Guile-commits] 05/99: separate js-il functions into actual functions and those for continuations,
Christopher Allan Webber <=
- [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, 2021/10/10