1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00

Change program type representation

This commit is contained in:
Ian Price 2015-06-20 22:41:24 +01:00
parent f0537e39ee
commit a7b2dfa581
4 changed files with 42 additions and 30 deletions

View file

@ -18,32 +18,33 @@
(set! exp (reify-primitives exp)) (set! exp (reify-primitives exp))
(set! exp (renumber exp)) (set! exp (renumber exp))
(match exp (match exp
(($ $program funs) (($ $program (($ $cont ks funs) ...))
;; TODO: I should special case the compilation for the initial fun, ;; 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 ;; as this is the entry point for the program, and shouldn't get a
;; "self" argument, for now, I add "undefined" as the first ;; "self" argument, for now, I add "undefined" as the first
;; argument in the call to it. ;; argument in the call to it.
;; see compile-exp in (language js-il compile-javascript) ;; see compile-exp in (language js-il compile-javascript)
(values (make-program (compile-fun (car funs)) (values (make-program
(map compile-fun (cdr funs))) (map (lambda (k fun)
(cons (make-kid k) (compile-fun fun)))
ks
funs))
env env
env)))) env))))
(define (compile-fun fun) (define (compile-fun fun)
(match fun (match fun
(($ $cont k ($ $kfun _ _ self ($ $cont tail ($ $ktail)) clause)) (($ $kfun _ _ self ($ $cont tail ($ $ktail)) clause)
(call-with-values (call-with-values
(lambda () (lambda ()
(extract-clauses self clause)) (extract-clauses self clause))
(lambda (jump-table clauses) (lambda (jump-table clauses)
(make-var (make-function
(make-kid k) (make-id self) (make-kid tail)
(make-function (make-local (map (lambda (clause)
(make-id self) (make-kid tail) (compile-clause clause self tail))
(make-local (map (lambda (clause) clauses)
(compile-clause clause self tail)) (make-jump-table jump-table))))))))
clauses)
(make-jump-table jump-table)))))))))
(define (extract-clauses self clause) (define (extract-clauses self clause)
(define (make-params* self req opts rest kw allow-other-keys?) (define (make-params* self req opts rest kw allow-other-keys?)

View file

@ -51,7 +51,7 @@
(define (print-js exp port) (define (print-js exp port)
(format port "#<js-il ~S>" (unparse-js exp))) (format port "#<js-il ~S>" (unparse-js exp)))
(define-js-type program entry body) (define-js-type program body)
(define-js-type function self tail body) (define-js-type function self tail body)
(define-js-type jump-table spec) (define-js-type jump-table spec)
(define-js-type params self req opt rest kw allow-other-keys?) (define-js-type params self req opt rest kw allow-other-keys?)
@ -71,8 +71,11 @@
(define (unparse-js exp) (define (unparse-js exp)
(match exp (match exp
(($ program entry body) (($ program body)
`(program ,(unparse-js entry) . ,(map unparse-js body))) `(program . ,(map (match-lambda
((($ kid k) . fun)
(cons k (unparse-js fun))))
body)))
(($ continuation params body) (($ continuation params body)
`(continuation ,(map unparse-js params) ,(unparse-js body))) `(continuation ,(map unparse-js params) ,(unparse-js body)))
(($ function self tail body) (($ function self tail body)

View file

@ -118,15 +118,23 @@
(define (compile-exp exp) (define (compile-exp exp)
;; TODO: handle ids for js ;; TODO: handle ids for js
(match exp (match exp
(($ il:program (and entry ($ il:var name _)) body) (($ il:program ((name . fun) (names . funs) ...))
(let ((entry-call (let ((entry-call
(make-return (make-return
(make-call (compile-id name) (make-call (compile-id name)
(list (list
(make-id "undefined") (make-id "undefined")
(make-refine *scheme* (make-const "initial_cont"))))))) (make-refine *scheme* (make-const "initial_cont")))))))
(make-call (make-function '() (append (map compile-exp body) (make-call (make-function
(list (compile-exp entry) entry-call))) '()
(append
(map (lambda (id f)
(make-var (rename-id id)
(compile-exp f)))
(cons name names)
(cons fun funs))
(list entry-call)))
'()))) '())))
(($ il:continuation params body) (($ il:continuation params body)

View file

@ -20,9 +20,8 @@
arg-list)) arg-list))
(define (analyse exp) (define (analyse exp)
(match exp (match exp
(($ program entry body) (($ program ((ids . funs) ...))
(analyse entry) (for-each analyse funs))
(for-each analyse body))
(($ function self tail body) (($ function self tail body)
(analyse body)) (analyse body))
@ -192,14 +191,15 @@
(make-var id (make-continuation params (inline body '())))))) (make-var id (make-continuation params (inline body '()))))))
bindings)) bindings))
(match fun (match fun
(($ var id ($ function self tail ($ local bindings ($ jump-table spec)))) (($ function self tail ($ local bindings ($ jump-table spec)))
(make-var id (make-function self
(make-function self tail
tail (make-local (handle-bindings bindings)
(make-local (handle-bindings bindings) (make-jump-table spec))))))
(make-jump-table spec)))))))
(match exp (match exp
(($ program entry body) (($ program ((ids . funs) ...))
(make-program (handle-function entry) (make-program (map (lambda (id fun)
(map handle-function body))))) (cons id (handle-function fun)))
ids
funs)))))