(define-library (csc cps) (export ir1->ir2) (import (only (csc gensym) gensym) (only (csc hash-map) alist->map insert merge) (only (csc ir1) constant? lexical-ref? lexical-set-expression lexical-set-ref lexical-set? library-define-expression library-define-ref library-define? library-ref? make-constant make-lexical-ref) (only (csc ir2) make-atom make-kargs make-ktail make-update) (scheme base)) (begin (define (make-soup . l) (alist->map (lambda (x) x) < l)) (define (new-ref) (make-lexical-ref 'generated-symbol (gensym))) (define-syntax cps-merge (syntax-rules () ((cps-merge new-continuations sub-cps) (let-values (((expr soup) sub-cps)) (values expr (merge soup new-continuations)))))) (define (to-cps expr continuation next-id) (cond ((or (constant? expr) (lexical-ref? expr) (library-ref? expr)) (values (make-atom expr continuation) (make-soup))) ((lexical-set? expr) (let ((id (next-id)) (ref (new-ref))) (cps-merge (make-soup (cons id (make-kargs (list ref) (make-update (lexical-set-ref expr) ref continuation)))) (to-cps (lexical-set-expression expr) id next-id)))) ((library-define? expr) (let ((id (next-id)) (ref (new-ref))) (cps-merge (make-soup (cons id (make-kargs (list ref) (make-update (library-define-ref expr) ref continuation)))) (to-cps (library-define-expression expr) id next-id)))) (else (error "unexpected type in to-cps" expr)))) ; Returns a map from integers to CPS continuations. ; By convention the continuation at key 0 is the entrypoint. (define (ir1->ir2 program) (define current-continuation-id 0) (define (next-id) (set! current-continuation-id (+ 1 current-continuation-id)) current-continuation-id) (define ktail (next-id)) (define-values (expr m) (to-cps program ktail next-id)) (set! m (insert m ktail (make-ktail))) (set! m (insert m 0 (make-kargs '() expr))) m)))