nybble
/
rosella
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Lots of misc. cleanup, and a few bug fixes. 

* Remap all instance variables in one pass, to avoid an insidious bug [1].
* Fix another bug by merging promote-shared-variables and narrow-binds [2].
* Don't assume different variable means different value in propogate-set!.
* Add support for (apply), (value-list) and (call-with-values) forms.
* Add support for including files (as if directly substituted) in reader.
* Use scheme/match library to simplify form pattern-matching.
* Refactor (map-form) and (search-form) using a more basic (traverse-form),
  which just recurses over the form and returns void by default, and a
  new utility function (curry-keywords) to provide default keyword arguments.

[1] Was renaming e.g. %f0 to %i0, then %i0 to %i1, which eliminates the
distinction between %f0 and %i0. Solution is to construct a map from old
names to new names, then traverse the form and change every old variable
to its new equivalent in the map exactly once.

[2] Some variables were not being promoted to boxes, as promotions only occur
at the top-level, when constructing each lambda, and narrow-binds could push
the unpromoted variables down into a subordinate lambda form first. Solution
was to promote variables immediately after narrowing bindings, including the
recursive calls which exist after pushing variables into nested scopes.
This commit is contained in:
Jesse D. McDonald 2010-05-02 04:13:38 -05:00
parent b3fd7bf6fc
commit cbcea20701
8 changed files with 628 additions and 601 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
compiler.scm
View File

@ -1,10 +1,15 @@
#! /usr/bin/mzscheme #! /usr/bin/mzscheme
#lang scheme/base #lang scheme/base
(require scheme/pretty)
(require (file "libcompiler/reader.scm")) (require (file "libcompiler/reader.scm"))
(require (file "libcompiler/compiler.scm")) (require (file "libcompiler/compiler.scm"))
(require (file "libcompiler/writer.scm")) (require (file "libcompiler/writer.scm"))
(optimize? #t)
;(pretty-print (reduce-function (read-module)))
(write-rla-value (compile-function (read-module))) (write-rla-value (compile-function (read-module)))
(write-char #\Newline) (write-char #\Newline)

6
libcompiler/compiler.scm
View File

@ -5,7 +5,9 @@
(require (file "mapper.scm")) (require (file "mapper.scm"))
(provide reduce-function (provide reduce-function
compile-function) compile-function
optimize?
box-free-variables?)
(define optimize? (make-parameter #t)) (define optimize? (make-parameter #t))
(define box-free-variables? (make-parameter #f)) (define box-free-variables? (make-parameter #f))
@ -16,7 +18,7 @@
(define (reduce-function lambda-form) (define (reduce-function lambda-form)
((compose (if (optimize?) optimize-function values) ((compose (if (optimize?) optimize-function values)
(if (box-free-variables?) promote-free-variables values) (if (box-free-variables?) promote-free-variables values)
simplify-function) simplify-lambda)
lambda-form)) lambda-form))
; vim:set sw=2 expandtab: ; vim:set sw=2 expandtab:

8
libcompiler/mapper.scm
View File

@ -24,10 +24,12 @@
(set! g-vars (append g-vars (list value))) (set! g-vars (append g-vars (list value)))
g-var)))) g-var))))
(for ([free-var (in-list (filter frame/instance-variable? (free-variables bind)))] (let* ([free-vars (filter frame/instance-variable? (free-variables bind))]
[var-map (for/list ([free-var (in-list free-vars)]
[inst-var (in-list instance-variables)]) [inst-var (in-list instance-variables)])
(set! i-vars (append i-vars (list free-var))) (set! i-vars (append i-vars (list free-var)))
(set! bind (subst-var free-var inst-var bind))) (list free-var inst-var))])
(set! bind (subst-var* var-map bind)))
(for ([bound-var (in-list (second bind))] (for ([bound-var (in-list (second bind))]
[frame-var (in-list frame-variables)]) [frame-var (in-list frame-variables)])
@ -44,3 +46,5 @@
`(,(if (null? i-vars) '%lambda '%template) ,g-vars ,i-vars `(,(if (null? i-vars) '%lambda '%template) ,g-vars ,i-vars
,bind))) ,bind)))
; vim:set sw=2 expandtab:

51
libcompiler/optimizer.scm
View File

@ -1,6 +1,7 @@
#lang scheme/base #lang scheme/base
(require scheme/list) (require scheme/list)
(require scheme/match)
(require (file "utilities.scm")) (require (file "utilities.scm"))
(provide reduce-variables (provide reduce-variables
@ -31,17 +32,13 @@
(if (and (pair? subform) (if (and (pair? subform)
(eq? (first subform) '%set!) (eq? (first subform) '%set!)
(or (memq (second subform) vars) (or (memq (second subform) vars)
; Top-level (free) variables are presumed to be (error "Setting unbound (constant) variable:" subform))
; constant. The alternative was to assume them
; to be boxes, which has its own complications.
(error "Setting unbound var:" subform))
(not (value-used? (second subform) after))) (not (value-used? (second subform) after)))
after after
(cons subform after))) (cons subform after)))
`(%bind ,vars `(%bind ,vars
,@(foldr prepend-if-used '() (map recurse subforms)))) ,@(foldr prepend-if-used '() (map recurse subforms))))
(narrow-binds (map-form form #:bind bind-fn))
(map-form form #:bind bind-fn)))
(define (propogate-value variable value invalidates? forms) (define (propogate-value variable value invalidates? forms)
(if (null? forms) (if (null? forms)
@ -84,53 +81,45 @@
; Known values are: ; Known values are:
; literals, always ; literals, always
; var, until (%set! var ...) ; var, until (%set! var ...)
; (%unbox var), until (%set-box! var ...) or (%set! var) ; (%unbox var), until (%set-box! ...) or (%set! var)
; (%car var), until (%set-car! var) or (%set! var) ; (%car var), until (%set-car! ...) or (%set! var)
; (%cdr var), until (%set-cdr! var) or (%set! var) ; (%cdr var), until (%set-cdr! ...) or (%set! var)
(define (propogate-set! form) (define (propogate-set! form)
(define (bind-fn recurse op vars . subforms) (define (bind-fn recurse op vars . subforms)
(define (prepend subform after) (define (prepend subform after)
(if (eq? (first subform) '%set!)
(let ([var (second subform)]
[value (third subform)])
(cons (cons
subform subform
(cond (match subform
[(simple-value? value) [`(%set! ,var ,(? simple-value? value))
(propogate-simple-value var value (propogate-simple-value var value
(lambda (form) (lambda (form)
(and (eq? (first form) '%set!) (and (eq? (first form) '%set!)
(eq? (second form) value))) (eq? (second form) value)))
after)] after)]
[(eq? (first value) '%unbox) [`(%set! ,var ,(and value `(%unbox ,box-var)))
(let ([box-var (second value)])
(propogate-value var value (propogate-value var value
(lambda (form) (lambda (form)
(or (and (eq? (first form) '%set!) (or (and (eq? (first form) '%set!)
(eq? (second form) box-var)) (eq? (second form) box-var))
(and (eq? (first form) '%set-box!) (eq? (first form) '%set-box!)))
(eq? (second form) box-var)))) after)]
after))] [`(%set! ,var ,(and value `(%car ,pair-var)))
[(eq? (first value) '%car)
(let ([pair-var (second value)])
(propogate-value var value (propogate-value var value
(lambda (form) (lambda (form)
(or (and (eq? (first form) '%set!) (or (and (eq? (first form) '%set!)
(eq? (second form) pair-var)) (eq? (second form) pair-var))
(and (eq? (first form) '%set-car!) (eq? (first form) '%set-car!)))
(eq? (second form) pair-var)))) after)]
after))] [`(%set! ,var ,(and value `(%cdr ,pair-var)))
[(eq? (first value) '%cdr)
(let ([pair-var (second value)])
(propogate-value var value (propogate-value var value
(lambda (form) (lambda (form)
(or (and (eq? (first form) '%set!) (or (and (eq? (first form) '%set!)
(eq? (second form) pair-var)) (eq? (second form) pair-var))
(and (eq? (first form) '%set-cdr!) (eq? (first form) '%set-cdr!)))
(eq? (second form) pair-var)))) after)]
after))] [_ after])))
[else after])))
(cons subform after)))
`(%bind ,vars `(%bind ,vars
,@(foldr prepend '() (map recurse subforms)))) ,@(foldr prepend '() (map recurse subforms))))
(map-form form #:bind bind-fn)) (map-form form #:bind bind-fn))
; vim:set sw=2 expandtab:

60
libcompiler/reader.scm
View File

@ -1,6 +1,7 @@
#lang scheme/base #lang scheme/base
(require scheme/list) (require scheme/list)
(require scheme/path)
(provide read-module) (provide read-module)
@ -8,24 +9,35 @@
`(lambda *argv* `(lambda *argv*
,@(let iter ([forms (read-forms port)] ,@(let iter ([forms (read-forms port)]
[bindings '()]) [bindings '()])
(cond (match forms
[(null? forms) (if (null? bindings) ['()
(if (null? bindings)
'() '()
`(letrec ,bindings))] `((letrec ,(reverse bindings))))]
[(simple-define-form? (first forms)) [`((define ,var ,expr) . ,rst)
(iter (cdr forms) (cons (cdr (first forms)) (iter rst (cons (list var expr) bindings))]
[`((define (,var . ,arglist) . ,body) . ,rst)
(iter rst (cons (list var `(lambda ,arglist ,@body)) bindings))]
[`((define . ,_) . ,_)
(error "Unrecognized define-form:" (first forms))]
[`((begin . ,body) . ,rst)
(iter (append body rst) bindings)]
[`((load ,(? string? pathname)) . ,rst)
(let ([complete-path (path->complete-path pathname)]
[directory (path-only complete-path)])
(iter (append (with-input-from-file complete-path
(lambda ()
(parameterize ([current-directory directory])
(read-forms))))
rst)
bindings))] bindings))]
[(lambda-define-form? (first forms)) [`((load . ,_) . ,rst)
(iter (cdr forms) (cons `(,(first (second (first forms))) (error "Unrecognized load-form:" (first forms))]
(lambda ,(cdr (second (first forms))) [(,form . ,rst)
,@(cddr (first forms)))) (if (null? bindings)
bindings))] (cons form (iter rst '()))
[(begin-form? (first forms)) `((letrec ,(reverse bindings)
(iter (append (cdr (first forms)) (cdr forms)) bindings)] ,@(cons form (iter rst '())))))]))))
[(null? bindings)
(cons (first forms) (iter (cdr forms) '()))]
[else
`((letrec ,bindings ,@(iter forms '())))]))))
(define (read-forms [port (current-input-port)]) (define (read-forms [port (current-input-port)])
(reverse (let iter ([form (read port)] (reverse (let iter ([form (read port)]
@ -34,20 +46,4 @@
forms forms
(iter (read port) (cons form forms)))))) (iter (read port) (cons form forms))))))
(define (simple-define-form? form)
(and (pair? form)
(eq? (first form) 'define)
(symbol? (second form))
(null? (cdddr form))))
(define (lambda-define-form? form)
(and (pair? form)
(eq? (first form) 'define)
(pair? (second form))
(symbol? (first (second form)))))
(define (begin-form? form)
(and (pair? form)
(eq? (first form) 'begin)))
; vim:set sw=2 expandtab: ; vim:set sw=2 expandtab:

560
libcompiler/simplifier.scm
View File

@ -1,32 +1,16 @@
#lang scheme/base #lang scheme/base
(require scheme/list) (require scheme/list)
(require scheme/match)
(require (file "utilities.scm")) (require (file "utilities.scm"))
(require (file "primitives.scm")) (require (file "primitives.scm"))
(provide simplify-function (provide simplify-lambda
promote-free-variables) promote-free-variables)
(define (simplify-function lambda-form)
((compose promote-shared-variables
simplify-lambda)
lambda-form))
(define (simplify-form form) (define (simplify-form form)
(define (same-form recurse . form) form) (define (same-form recurse . form) form)
(map-form form (define (simplify-complex-form recurse op . others)
#:bind same-form
#:lambda same-form
#:set same-form
#:primitive same-form
#:simple (lambda (recurse kind form) form)
#:literal (lambda (recurse kind form)
(if (and (pair? form)
(eq? (first form) 'quote)
(eq? (second form) '()))
'%nil
form))
#:other (lambda (recurse op . others)
(case op (case op
[(let) (simplify-let form)] [(let) (simplify-let form)]
[(let*) (simplify-let* form)] [(let*) (simplify-let* form)]
@ -47,41 +31,84 @@
`(let ([,a ,(second form)] `(let ([,a ,(second form)]
[,b ,(third form)]) [,b ,(third form)])
(fix>= ,b ,a))))] (fix>= ,b ,a))))]
[(value-list) (simplify-value-list form)]
[(values) (simplify-primitive '%values (cdr form))] [(values) (simplify-primitive '%values (cdr form))]
[(apply) (simplify-apply (second form) (cddr form))]
[(call/cc) (simplify-primitive '%call/cc (cdr form))] [(call/cc) (simplify-primitive '%call/cc (cdr form))]
[(call-with-values)
(simplify-form
`(apply ,(third form)
(value-list (,(second form)))))]
[else [else
(let ([primitive (memf (lambda (x) (eq? (third x) (first form))) (let ([primitive (memf (lambda (x) (eq? (third x) (first form)))
all-primitives)]) all-primitives)])
(if primitive (if primitive
(simplify-primitive (first (first primitive)) (simplify-primitive (first (first primitive))
(cdr form)) (cdr form))
(simplify-funcall form)))])))) (simplify-apply (first form) (append (cdr form) '(%nil)))))]))
(map-form form
#:bind same-form
#:lambda same-form
#:set same-form
#:value-list same-form
#:primitive same-form
#:simple (lambda (recurse kind form) form)
#:literal (lambda (recurse kind form)
(if (equal? form '(quote ())) '%nil form))
#:other simplify-complex-form))
(define (simplify-set! form) (define (simplify-set! form)
(let ([variable (second form)] (let ([variable (second form)]
[value-form (simplify-form (third form))]) [value-form (simplify-form (third form))])
(if (and (pair? value-form) (eq? (first value-form) '%bind)) (match value-form
(if (memq variable (second value-form)) [`(%bind ,bound-vars . ,subforms)
(if (memq variable bound-vars)
(let ([tmp (gensym)]) (let ([tmp (gensym)])
`(%bind (,tmp) `(%bind (,tmp)
; guaranteed not to cause unbounded recursion: tmp is unique ; guaranteed not to cause unbounded recursion: tmp is unique
,(simplify-set! `(set! ,tmp ,value-form)) ,(simplify-set! `(set! ,tmp ,value-form))
(%set! ,variable ,tmp))) (%set! ,variable ,tmp)))
`(%bind ,(second value-form) `(%bind ,bound-vars
,@(foldr (lambda (subform after) ,@(foldr (lambda (subform after)
(cond (if (pair? after)
[(pair? after) (cons subform after)] (cons subform after)
[(and (pair? subform) (eq? (first subform) '%values)) (list (simplify-set! `(set! ,variable ,subform)))))
; Requires at least one value; ignores extras.
(if (null? (cdr subform))
(error "Attempted to set variable to void in:" form)
`((%set! ,variable ,(second subform))))]
[(value-form? subform)
(list (simplify-set! `(set! ,variable ,subform)))]
[else (error "Attempted to set variable to void in:" form)]))
'() '()
(cddr value-form)))) subforms)))]
`(%set! ,variable ,value-form)))) [`(%values ,first-val . ,other-vals)
`(%set! ,variable ,first-val)]
[`(%values)
(error "Attempted to set variable to void in:" form)]
[(? value-form?)
`(%set! ,variable ,value-form)]
[else
(error "Attempted to set variable to void in:" form)])))
(define (simplify-value-list form)
(let ([values-form (simplify-form (second form))])
(match values-form
[`(%bind ,bound-vars . ,subforms)
`(%bind ,bound-vars
,@(foldr (lambda (subform after)
(if (pair? after)
(cons subform after)
(list (simplify-value-list `(value-list ,subform)))))
'()
subforms))]
[`(%values . ,simple-vals)
; (%value-list (%values ...)) => (list ...)
(let ([tmp (gensym)])
`(%bind (,tmp)
(%set! ,tmp %nil)
,@(map (lambda (x) (simplify-set! `(set! ,tmp (cons ,x ,tmp))))
(reverse simple-vals))
,tmp))]
[(or `(%apply _ _)
`(%call/cc _))
`(%value-list ,values-form)]
[(? value-form?)
(simplify-value-list `(value-list (values ,values-form)))]
[_ '%nil])))
(define (simplify-primitive simple-op value-forms) (define (simplify-primitive simple-op value-forms)
(define (value->binding value-form) (define (value->binding value-form)
@ -207,218 +234,12 @@
; (if (eq? argv-temp %nil) ; (if (eq? argv-temp %nil)
; (set! optional-1 default-expr-1) ; (set! optional-1 default-expr-1)
; (set! optional-1 (car argv-temp))) ; (set! optional-1 (car argv-temp)))
; ; TODO: Handle keyword arguments here...
; (set! argv-temp (cdr argv-temp)) ; (set! argv-temp (cdr argv-temp))
; (... ; (...
; (let ([rest argv-temp]) ; (let ([rest argv-temp])
; bodyexpr...)...)))...))) ; bodyexpr...)...)))...)))
(define (split-arglist arglist)
(define (split-optional arglist)
(if (pair? arglist)
(let-values ([(opt rst) (split-optional (cdr arglist))])
(values (cons (car arglist) opt) rst))
(values '() arglist)))
(cond
[(null? arglist) (values '() '() #f)]
[(not (pair? arglist)) (values '() '() arglist)]
[(pair? (car arglist)) (let-values ([(opt rst) (split-optional arglist)])
(values '() opt rst))]
[else (let-values ([(req opt rst) (split-arglist (cdr arglist))])
(values (cons (car arglist) req) opt rst))]))
(define (add-return ctx k nested-bind)
(define flat-bind (flatten-binds nested-bind))
(define argv (gensym))
`(%bind (,@(second flat-bind) ,argv)
,@(foldr (lambda (subform after)
(cond
[(pair? after)
(cons subform after)]
[(simple-value? subform)
`((%set! ,argv (%cons ,subform %nil))
(%tail-call ,k ,argv #f #f))]
[(eq? (first subform) '%apply)
`((%tail-call ,(second subform) ,(third subform) ,ctx ,k))]
[(eq? (first subform) '%call/cc)
`((%set! ,argv (%cons %k %nil))
(%tail-call ,(second subform) ,argv ,ctx %k))]
[(eq? (first subform) '%values)
`((%set! ,argv %nil)
,@(map (lambda (sv) `(%set! ,argv (%cons ,sv ,argv)))
(reverse (cdr subform)))
(%tail-call ,k ,argv #f #f))]
[(value-form? subform)
`((%set! ,argv ,subform)
(%set! ,argv (%cons ,argv %nil))
(%tail-call ,k ,argv #f #f))]
[(eq? (first subform) '%tail-call)
`(,subform)]
[else
`(,subform
(%tail-call ,k %nil #f #f))]))
'()
(cddr flat-bind))))
; <= (%bind (var...)
; @before
; (%apply x y)
; @after))
; => (%bind (var... k)
; @before
; (%set! k (lambda _ @after))
; (%tail-call x y ctx k)))
; <= (%bind (var...)
; @before
; (%set! v (%apply x y))
; @after))
; => (%bind (var... k)
; @before
; (%set! k (lambda (x)
; (%set! v x)
; @after))
; (%tail-call x y ctx k)))
; <= (%bind (var...)
; @before
; (call/cc l)
; @after)
; => (%bind (var... k k2)
; @before
; (%set! k (lambda _ @after))
; (%set! k-argv (%cons k %nil))
; (%tail-call l k-argv ctx k))
(define (transform-to-cps ctx nested-bind)
(define flat-bind (flatten-binds nested-bind))
(define (cps-prepend subform after)
(cond
; (%set! v (%apply x y))
[(and (pair? subform)
(eq? (first subform) '%set!)
(pair? (third subform))
(eq? (first (third subform)) '%apply))
(let ([k (gensym)]
[x (gensym)])
`((%bind (,k ,x)
(%set! ,k ,(simplify-form
`(lambda (,x . ,(gensym))
(%set! ,(second subform) ,x)
,@after)))
(%tail-call ,(second (third subform))
,(third (third subform))
,ctx
,k))))]
; (%apply x y)
[(and (pair? subform)
(eq? (first subform) '%apply))
(let ([k (gensym)])
`((%bind (,k)
(%set! ,k ,(simplify-form
`(lambda ,(gensym)
,@after)))
(%tail-call ,(second subform)
,(third subform)
,ctx
,k))))]
; (%set! v (%call/cc x))
[(and (pair? subform)
(eq? (first subform) '%set!)
(pair? (third subform))
(eq? (first (third subform)) '%call/cc))
(let ([k (gensym)]
[k-argv (gensym)]
[x (gensym)])
`((%bind (,k ,k-argv)
(%set! ,k ,(simplify-form
`(lambda (,x . ,(gensym))
(%set! ,(second subform) ,x)
,@after)))
(%set! ,k-argv (%cons ,k %nil))
(%tail-call ,(second (third subform))
,k-argv
,ctx
,k))))]
; (%call/cc x)
[(and (pair? subform)
(eq? (first subform) '%call/cc))
(let ([k (gensym)]
[k-argv (gensym)])
`((%bind (,k ,k-argv)
(%set! ,k ,(simplify-form
`(lambda ,(gensym)
,@after)))
(%set! ,k-argv (%cons ,k %nil))
(%tail-call ,(second subform)
,k-argv
,ctx
,k))))]
; keep all other forms with side-effects as-is
[(statement-form? subform)
(cons subform after)]
; discard any form without side-effects
[else after]))
(flatten-binds
`(%bind ,(second flat-bind)
,@(foldr cps-prepend '() (cddr flat-bind)))))
(define (simplify-lambda form)
(define arglist (car (cdr form)))
(define bodyexprs (cdr (cdr form)))
(define-values (requireds optionals rest) (split-arglist arglist))
(define argv (gensym))
(define ctx (gensym))
(define k (gensym))
(define (add-req req inner) `(let ([,req (car ,argv)])
(set! ,argv (cdr ,argv))
,inner))
(define (add-opt opt-list inner) `(let (,(car opt-list))
(if (pair? ,argv)
(begin
(set! ,(first opt-list) (car ,argv))
(set! ,argv (cdr ,argv)))
(set! ,(first opt-list) ,(second opt-list)))
,inner))
(define rest+bodyexprs (if rest `(let ([,rest ,argv]) ,@bodyexprs)
`(begin ,@bodyexprs)))
(narrow-binds
`(%lambda () ()
,((compose (lambda (bind) (transform-to-cps ctx bind))
(lambda (bind) (add-return ctx k bind)))
(simplify-form
`(let ([,argv %argv]
[,ctx %ctx]
[,k %k])
,(foldr add-req
(foldr add-opt
rest+bodyexprs
optionals)
requireds)))))))
; (fn-expr arg-expr...)
; => (let ([fn-var fn-expr] arg-var... argv)
; (set! fn-var fn-expr)
; (set! arg-var arg-expr)...
; (set! argv %nil)
; (set! argv (cons arg-var argv))... [reversed]
; (%apply fn-var argv))
(define (simplify-funcall form)
(define fn-expr (car form))
(define arg-exprs (cdr form))
(define fn-var (gensym))
(define arg-vars (map (lambda (x) (gensym)) arg-exprs))
(define argv (gensym))
(simplify-form
`(let (,fn-var ,@arg-vars ,argv)
(set! ,fn-var ,fn-expr)
,@(map (lambda (x y) `(set! ,x ,y)) arg-vars arg-exprs)
(%set! ,argv %nil)
,@(reverse (map (lambda (x) `(%set! ,argv (%cons ,x ,argv))) arg-vars))
(%apply ,fn-var ,argv))))
(define (promote-to-box variable form) (define (promote-to-box variable form)
(map-form form (map-form form
#:bind (lambda (recurse op vars . subforms) #:bind (lambda (recurse op vars . subforms)
@ -438,6 +259,8 @@
,(simplify-set! `(set! ,tmp ,new-value)) ,(simplify-set! `(set! ,tmp ,new-value))
(%set-box! ,variable ,tmp)))) (%set-box! ,variable ,tmp))))
(simplify-set! `(set! ,var ,new-value))))) (simplify-set! `(set! ,var ,new-value)))))
#:value-list (lambda (recurse op values-form)
`(,op ,(recurse values-form)))
#:primitive (lambda (recurse op . simple-values) #:primitive (lambda (recurse op . simple-values)
(let ([new-args (map recurse simple-values)]) (let ([new-args (map recurse simple-values)])
;; if any new-arg is not simple, must bind to a temp first ;; if any new-arg is not simple, must bind to a temp first
@ -455,39 +278,244 @@
#:variable (lambda (recurse op var) #:variable (lambda (recurse op var)
(if (eq? var variable) `(%unbox ,variable) var)))) (if (eq? var variable) `(%unbox ,variable) var))))
; form needs to be flattened (%bind ...) (define (is-shared-var? var forms)
(define (is-shared-var? var bind) (define captured-input? (ormap (lambda (f) (form-captures-input? f var)) forms))
(define captured-input? (ormap (lambda (f) (form-captures-input? f var)) (cddr bind))) (define captured-output? (ormap (lambda (f) (form-captures-output? f var)) forms))
(define captured-output? (ormap (lambda (f) (form-captures-output? f var)) (cddr bind))) (define (set-after-first-capture?)
(define (set-after-first-use?)
(let/cc return (let/cc return
(foldr (lambda (subform set-after?) (foldr (lambda (form set-after?)
(if (or set-after? (form-sets? subform var captured-output?)) (if (or set-after? (form-sets? form var captured-output?))
(if (form-uses? subform var captured-input?) (if (form-captures-input? form var)
(return #t) (return #t)
#t) #t)
#f)) #f))
#f #f
(cddr bind)) forms)
#f)) #f))
(and (not (special-variable? var)) (or captured-output?
(or captured-input? (and captured-input?
captured-output?) (set-after-first-capture?))))
(set-after-first-use?)))
(define (promote-shared-variables simple-lambda-form) (define (promote-shared-variables nested-bind)
(define bind (fourth simple-lambda-form)) (define flat-bind (flatten-binds nested-bind))
`(%lambda ,(second simple-lambda-form) ,(third simple-lambda-form) (foldl (lambda (var frm)
,(foldl (lambda (var frm) (if (is-shared-var? var (cddr frm))
(if (is-shared-var? var frm)
(promote-to-box var frm) (promote-to-box var frm)
frm)) frm))
bind flat-bind
(second bind)))) (second flat-bind)))
(define (promote-free-variables simple-lambda-form) (define (promote-free-variables form)
(define bind (fourth simple-lambda-form)) (foldl promote-to-box form (free-variables form)))
`(%lambda ,(second simple-lambda-form) ,(third simple-lambda-form)
,(foldl promote-to-box bind (free-variables bind)))) (define (narrow-binds+promote nested-bind)
(define flat-bind (flatten-binds nested-bind))
(define (at-top-level? var)
(or (ormap (lambda (x) (form-sets? x var #f)) (cddr flat-bind))
(ormap (lambda (x) (form-uses? x var #f)) (cddr flat-bind))))
(define (captured-twice? var)
(let/cc return
(foldl (lambda (subform once?)
(if (form-captures? subform var)
(if once? (return #t) #t)
once?))
(at-top-level? var)
(cddr flat-bind))
#f))
(define extra-bindings
(filter-not captured-twice?
(filter-not at-top-level?
(second flat-bind))))
(promote-shared-variables
`(%bind ,(remove* extra-bindings (second flat-bind))
,@(map (lambda (subform)
(match subform
[`(%set! ,var (%lambda ,g-vars ,i-vars ,bind))
`(%set! ,var (%lambda ,g-vars ,i-vars
,(narrow-binds+promote
(foldl (lambda (var temp-bind)
(if (memq var (free-variables temp-bind))
`(%bind (,@(second temp-bind) ,var)
,@(cddr temp-bind))
temp-bind))
bind
extra-bindings))))]
[_ subform]))
(cddr flat-bind)))))
(define (split-arglist arglist)
(match arglist
[`(,(? symbol? reqs) ... ,(and opts (list (? symbol?) _)) ... . ,(? symbol? rst))
(values reqs opts rst)]
[`(,(? symbol? reqs) ... ,(and opts (list (? symbol?) _)) ...)
(values reqs opts #f)]
[_ (error "Invalid argument list:" arglist)]))
(define (add-return ctx k nested-bind)
(define flat-bind (flatten-binds nested-bind))
(define argv (gensym))
`(%bind (,@(second flat-bind) ,argv)
,@(foldr (lambda (subform after)
(if (pair? after)
(cons subform after)
(match subform
[(? simple-value?)
`((%set! ,argv (%cons ,subform %nil))
(%tail-call ,k ,argv #f #f))]
[`(%apply ,x ,y)
`((%tail-call ,x ,y ,ctx ,k))]
[`(%call/cc ,x)
`((%set! ,argv (%cons %k %nil))
(%tail-call ,x ,argv ,ctx %k))]
[`(%values . ,simple-vals)
`((%set! ,argv %nil)
,@(map (lambda (sv) `(%set! ,argv (%cons ,sv ,argv)))
(reverse simple-vals))
(%tail-call ,k ,argv #f #f))]
[(? value-form?)
`(,(simplify-set! `(set! ,argv ,subform))
(%set! ,argv (%cons ,argv %nil))
(%tail-call ,k ,argv #f #f))]
[`(%tail-call . ,_)
`(,subform)]
[_
`(,subform
(%tail-call ,k %nil #f #f))])))
'()
(cddr flat-bind))))
(define (transform-to-cps ctx nested-bind)
(define flat-bind (flatten-binds nested-bind))
(define (cps-prepend subform after)
(match subform
[`(%set! ,v (%value-list (%apply ,x ,y)))
(let ([k (gensym)])
`((%bind (,k)
(%set! ,k ,(simplify-form
`(lambda ,v
,@after)))
(%tail-call ,x ,y ,ctx ,k))))]
[`(%set! ,v (%apply ,x ,y))
(let ([k (gensym)])
`((%bind (,k)
(%set! ,k ,(simplify-form
`(lambda (,v . ,(gensym))
,@after)))
(%tail-call ,x ,y ,ctx ,k))))]
[(or `(%value-list (%apply ,x ,y))
`(%apply ,x ,y))
(let ([k (gensym)])
`((%bind (,k)
(%set! ,k ,(simplify-form
`(lambda ,(gensym)
,@after)))
(%tail-call ,x ,y ,ctx ,k))))]
[`(%set! ,v (%value-list (%call/cc ,x)))
(let ([k (gensym)]
[k-argv (gensym)])
`((%bind (,k ,k-argv)
(%set! ,k ,(simplify-form
`(lambda ,v
,@after)))
(%set! ,k-argv (%cons ,k %nil))
(%tail-call ,x ,k-argv ,ctx ,k))))]
[`(%set! ,v (%call/cc ,x))
(let ([k (gensym)]
[k-argv (gensym)])
`((%bind (,k ,k-argv)
(%set! ,k ,(simplify-form
`(lambda (,v . ,(gensym))
,@after)))
(%set! ,k-argv (%cons ,k %nil))
(%tail-call ,x ,k-argv ,ctx ,k))))]
[(or `(%value-list (%call/cc ,x))
`(%call/cc ,x))
(let ([k (gensym)]
[k-argv (gensym)])
`((%bind (,k ,k-argv)
(%set! ,k ,(simplify-form
`(lambda ,(gensym)
,@after)))
(%set! ,k-argv (%cons ,k %nil))
(%tail-call ,x ,k-argv ,ctx ,k))))]
; keep all other forms with side-effects as-is
[(? statement-form?) (cons subform after)]
; discard any form without side-effects
[_ after]))
`(%bind ,(second flat-bind)
,@(foldr cps-prepend '() (cddr flat-bind))))
(define (simplify-lambda form)
(define arglist (cadr form))
(define bodyexprs (cddr form))
(define-values (requireds optionals rest) (split-arglist arglist))
(define argv (gensym))
(define ctx (gensym))
(define k (gensym))
(define (add-req req inner)
`(let ([,req (car ,argv)])
(set! ,argv (cdr ,argv))
,inner))
(define (add-opt opt-list inner)
`(let (,(car opt-list))
(if (pair? ,argv)
(begin
(set! ,(first opt-list) (car ,argv))
(set! ,argv (cdr ,argv)))
(set! ,(first opt-list) ,(second opt-list)))
,inner))
(define rest+bodyexprs
(if rest
`(let ([,rest ,argv]) ,@bodyexprs)
`(begin ,@bodyexprs)))
`(%lambda () ()
,((compose narrow-binds+promote
(lambda (bind) (transform-to-cps ctx bind))
(lambda (bind) (add-return ctx k bind))
simplify-form)
`(let ([,argv %argv]
[,ctx %ctx]
[,k %k])
,(foldr add-req
(foldr add-opt
rest+bodyexprs
optionals)
requireds)))))
; (fn-expr arg-expr...)
; => (let ([fn-var fn-expr] arg-var... argv)
; (set! fn-var fn-expr)
; (set! arg-var arg-expr)...
; (set! argv %nil)
; (set! argv (cons arg-var argv))... [reversed]
; (%apply fn-var argv))
(define (simplify-apply fn-expr arg-exprs)
(define fn-var (gensym))
(define argv (gensym))
(define arguments
(foldr (lambda (expr args)
(if (null? args)
(cons (list argv expr) args)
(if (literal-value? expr)
(cons (list expr #f) args)
(cons (list (gensym) expr) args))))
'()
arg-exprs))
(simplify-form
`(let ([,fn-var ,fn-expr] ,@(filter second arguments))
,@(map (lambda (x) `(%set! ,argv (%cons ,x ,argv)))
(map first (reverse (drop-right arguments 1))))
(%apply ,fn-var ,argv))))
; vim:set sw=2 expandtab: ; vim:set sw=2 expandtab:

257
libcompiler/utilities.scm
View File

@ -1,12 +1,15 @@
#lang scheme/base #lang scheme/base
(require scheme/list) (require scheme/list)
(require scheme/match)
(require scheme/pretty) (require scheme/pretty)
(require (file "primitives.scm")) (require (file "primitives.scm"))
(provide trace (provide trace
subst subst
subst*
find find
curry-keywords
variable-value? variable-value?
literal-value? literal-value?
simple-value? simple-value?
@ -15,6 +18,7 @@
primitive-form? primitive-form?
pure-form? pure-form?
bind-form? bind-form?
traverse-form
map-form map-form
search-form search-form
form-sets? form-sets?
@ -22,8 +26,8 @@
form-captures? form-captures?
form-captures-input? form-captures-input?
form-captures-output? form-captures-output?
narrow-binds
subst-var subst-var
subst-var*
flatten-binds flatten-binds
free-variables free-variables
free-input-variables free-input-variables
@ -37,10 +41,14 @@
(define (subst old new lst) (define (subst old new lst)
(foldr (lambda (x rst) (foldr (lambda (x rst)
(cons (if (eq? x old) (cons (if (eq? x old) new x) rst))
new '()
x) lst))
rst))
(define (subst* old->new lst)
(foldr (lambda (x rst)
(let ([item (assoc x old->new)])
(cons (if item (second item) x) rst)))
'() '()
lst)) lst))
@ -51,6 +59,43 @@
(when (eq? y x) (return i))) (when (eq? y x) (return i)))
#f)) #f))
;; Combines two sorted keyword-value list pairs into a single
;; sorted list-pair, taking the values from the second list
;; where the same keyword exists in both lists.
(define (merge-keywords keywords-1 kw-values-1 keywords-2 kw-values-2)
(let iter ([kw '()] [kv '()]
[kw-1 keywords-1] [kv-1 kw-values-1]
[kw-2 keywords-2] [kv-2 kw-values-2])
(cond
[(null? kw-2) (values (append (reverse kw) kw-1) (append (reverse kv) kv-1))]
[(null? kw-1) (values (append (reverse kw) kw-2) (append (reverse kv) kv-2))]
[(eq? (car kw-1) (car kw-2))
(iter (cons (car kw-2) kw) (cons (car kv-2) kv)
(cdr kw-1) (cdr kv-1)
(cdr kw-2) (cdr kv-2))]
[(keyword<? (car kw-1) (car kw-2))
(iter (cons (car kw-1) kw) (cons (car kv-1) kv)
(cdr kw-1) (cdr kv-1)
kw-2 kv-2)]
[else
(iter (cons (car kw-2) kw) (cons (car kv-2) kv)
kw-1 kv-1
(cdr kw-2) (cdr kv-2))])))
;; Like (curry ...) from scheme/function, but with much better support for
;; keyword arguments. Keyword arguments supplied to curry-keywords act as
;; defaults, which may be overridden by keywords passed to the resulting
;; function. It can also curry non-keyword arguments, naturally.
(define curry-keywords
(make-keyword-procedure
(lambda (curried-keywords curried-kw-values fn . curried-non-keywords)
(make-keyword-procedure
(lambda (keywords kw-values . non-keywords)
(let-values ([(all-keywords all-kw-values)
(merge-keywords curried-keywords curried-kw-values keywords kw-values)])
(keyword-apply fn all-keywords all-kw-values
(append curried-non-keywords non-keywords))))))))
(define (variable-value? form) (define (variable-value? form)
(and (symbol? form) (and (symbol? form)
(not (eq? form '%undef)))) (not (eq? form '%undef))))
@ -68,7 +113,7 @@
; A value-form is any simple form which can appear on the right-hand side of a (set! ...). ; A value-form is any simple form which can appear on the right-hand side of a (set! ...).
; If there are any side-effect they occur before the variable is updated. ; If there are any side-effect they occur before the variable is updated.
(define (value-form? form) (define (value-form? form)
(define complex-values '(%bind %apply %call/cc %values)) (define complex-values '(%bind %lambda %apply %call/cc %values %value-list))
(or (simple-value? form) (or (simple-value? form)
(memq (first form) complex-values) (memq (first form) complex-values)
(memq (first form) (map first value-primitives)))) (memq (first form) (map first value-primitives))))
@ -91,43 +136,44 @@
(define (bind-form? form) (define (bind-form? form)
(and (pair? form) (eq? (first form) '%bind))) (and (pair? form) (eq? (first form) '%bind)))
(define (map-form form (define (traverse-form form
#:bind [bind-fn (lambda (recurse op vars . subforms) #:bind [bind-fn (lambda (recurse op vars . subforms)
`(,op ,vars ,@(map recurse subforms)))] (for ([subform (in-list subforms)])
(recurse subform)))]
#:lambda [lambda-fn (lambda (recurse op g-vars i-vars bind) #:lambda [lambda-fn (lambda (recurse op g-vars i-vars bind)
`(,op ,g-vars ,i-vars ,(recurse bind)))] (recurse bind))]
#:set [set-fn (lambda (recurse op var value) #:set [set-fn (lambda (recurse op var value-form)
`(,op ,var ,(recurse value)))] (recurse value-form))]
#:value-list [value-list-fn (lambda (recurse op values-form)
(recurse values-form))]
#:primitive [primitive-fn (lambda (recurse op . simple-values) #:primitive [primitive-fn (lambda (recurse op . simple-values)
`(,op ,@(map recurse simple-values)))] (for ([val (in-list simple-values)])
(recurse val)))]
#:simple [simple-fn (lambda (recurse kind simple-value) (void))]
#:other [other-fn (lambda (recurse . form)
(error "Unsimplified form:" form))]
#:values [values-fn primitive-fn] #:values [values-fn primitive-fn]
#:call [call-fn primitive-fn] #:call [call-fn primitive-fn]
#:apply [apply-fn call-fn]
#:call/cc [call/cc-fn call-fn]
#:tail-call [tail-call-fn call-fn]
#:simple [simple-fn (lambda (recurse kind form) form)]
#:variable [variable-fn simple-fn] #:variable [variable-fn simple-fn]
#:literal [literal-fn simple-fn] #:literal [literal-fn simple-fn]
#:apply [apply-fn call-fn]
#:other [other-fn (lambda (recurse . form) #:call/cc [call/cc-fn call-fn]
(error "Unsimplified form:" form))]) #:tail-call [tail-call-fn call-fn])
(define (recurse subform) (define (recurse subform)
(map-form subform ; Can skip #:primitive, #:call, and #:simple, which only set defaults.
(traverse-form subform
#:bind bind-fn #:bind bind-fn
#:lambda lambda-fn #:lambda lambda-fn
#:set set-fn #:set set-fn
#:value-list value-list-fn
#:primitive primitive-fn #:primitive primitive-fn
#:other other-fn
#:values values-fn #:values values-fn
#:call call-fn
#:apply apply-fn
#:call/cc call/cc-fn
#:tail-call tail-call-fn
#:simple simple-fn
#:variable variable-fn #:variable variable-fn
#:literal literal-fn #:literal literal-fn
#:other other-fn)) #:apply apply-fn
#:call/cc call/cc-fn
#:tail-call tail-call-fn))
(cond (cond
[(variable-value? form) (variable-fn recurse 'variable form)] [(variable-value? form) (variable-fn recurse 'variable form)]
@ -137,6 +183,7 @@
[(%bind) bind-fn] [(%bind) bind-fn]
[(%lambda) lambda-fn] [(%lambda) lambda-fn]
[(%set!) set-fn] [(%set!) set-fn]
[(%value-list) value-list-fn]
[(%values) values-fn] [(%values) values-fn]
[(%apply) apply-fn] [(%apply) apply-fn]
[(%call/cc) call/cc-fn] [(%call/cc) call/cc-fn]
@ -146,45 +193,34 @@
other-fn)])]) other-fn)])])
(apply handler recurse form))])) (apply handler recurse form))]))
; Like map-form, but intended for boolean results. (Just different defaults.) (define map-form
(define (search-form form (curry-keywords traverse-form
#:merge-with [merge-fn ormap] #:bind (lambda (recurse op vars . subforms)
#:base-value [base-value #f] `(,op ,vars ,@(map recurse subforms)))
#:bind [bind-fn (lambda (recurse op vars . subforms) #:lambda (lambda (recurse op g-vars i-vars bind)
(merge-fn recurse subforms))] `(,op ,g-vars ,i-vars ,(recurse bind)))
#:lambda [lambda-fn (lambda (recurse op g-vars i-vars bind) #:set (lambda (recurse op var value-form)
(recurse bind))] `(,op ,var ,(recurse value-form)))
#:set [set-fn (lambda (recurse op var value) #:value-list (lambda (recurse op values-form)
(recurse value))] `(,op ,(recurse values-form)))
#:primitive (lambda (recurse op . simple-values)
`(,op ,@(map recurse simple-values)))
#:simple (lambda (recurse kind form) form)))
#:primitive [primitive-fn (lambda (recurse op . simple-values) ; Like map-form, but intended for boolean results.
(merge-fn recurse simple-values))] (define search-form
#:values [values-fn primitive-fn] (curry-keywords traverse-form
#:call [call-fn primitive-fn] #:bind (lambda (recurse op vars . subforms)
#:apply [apply-fn call-fn] (ormap recurse subforms))
#:call/cc [call/cc-fn call-fn] #:lambda (lambda (recurse op g-vars i-vars bind)
#:tail-call [tail-call-fn call-fn] (recurse bind))
#:set (lambda (recurse op var value)
#:simple [simple-fn (lambda (recurse kind form) base-value)] (recurse value))
#:variable [variable-fn simple-fn] #:value-list (lambda (recurse op var values-form)
#:literal [literal-fn simple-fn] (recurse values-form))
#:primitive (lambda (recurse op . simple-values)
#:other [other-fn (lambda (recurse . form) (ormap recurse simple-values))
(error "Unsimplified form:" form))]) #:simple (lambda (recurse kind form) #f)))
(map-form form
#:bind bind-fn
#:lambda lambda-fn
#:set set-fn
#:primitive primitive-fn
#:values values-fn
#:call call-fn
#:apply apply-fn
#:call/cc call/cc-fn
#:tail-call tail-call-fn
#:simple simple-fn
#:variable variable-fn
#:literal literal-fn
#:other other-fn))
(define (form-sets? form variable [call-may-set? #t]) (define (form-sets? form variable [call-may-set? #t])
(search-form form (search-form form
@ -192,17 +228,17 @@
(and (not (memq variable vars)) (and (not (memq variable vars))
(ormap recurse subforms))) (ormap recurse subforms)))
#:lambda (lambda _ #f) #:lambda (lambda _ #f)
#:set (lambda (recurse op var complex-value) #:set (lambda (recurse op var value-form)
(eq? var variable)) (or (eq? var variable)
(recurse value-form)))
#:call (lambda _ call-may-set?))) #:call (lambda _ call-may-set?)))
(define (form-uses? form variable [call-may-use? #t] [descend? #t]) (define (form-uses? form variable [call-may-use? #t])
(search-form form (search-form form
#:bind (lambda (recurse op vars . subforms) #:bind (lambda (recurse op vars . subforms)
(and (not (memq variable vars)) (and (not (memq variable vars))
(ormap recurse subforms))) (ormap recurse subforms)))
#:lambda (lambda (recurse op g-vars i-vars bind) #:lambda (lambda (recurse . form) #f)
(and descend? (recurse bind)))
#:call (lambda (recurse op . simple-values) #:call (lambda (recurse op . simple-values)
(or call-may-use? (ormap recurse simple-values))) (or call-may-use? (ormap recurse simple-values)))
#:variable (lambda (recurse op var) (eq? var variable)))) #:variable (lambda (recurse op var) (eq? var variable))))
@ -224,7 +260,8 @@
(define (value-used? variable forms) (define (value-used? variable forms)
(cond (cond
[(null? forms) #f] [(null? forms) #f]
[(form-uses? (first forms) variable #f #t) #t] [(form-captures-input? (first forms) variable) #t]
[(form-uses? (first forms) variable #f) #t]
[(form-sets? (first forms) variable #f) #f] [(form-sets? (first forms) variable #f) #f]
[else (value-used? variable (cdr forms))])) [else (value-used? variable (cdr forms))]))
@ -237,51 +274,16 @@
#:variable (lambda (recurse op var) #:variable (lambda (recurse op var)
(if (eq? var old-var) new-var var)))) (if (eq? var old-var) new-var var))))
(define (narrow-binds simple-lambda-form) (define (subst-var* var-map form)
(define bind (fourth simple-lambda-form)) (map-form form
#:bind (lambda (recurse op vars . subforms)
(define (at-top-level? var) `(%bind ,(subst* var-map vars) ,@(map recurse subforms)))
(or (ormap (lambda (x) (form-sets? x var #f)) (cddr bind)) #:set (lambda (recurse op var value)
(ormap (lambda (x) (form-uses? x var #f #f)) (cddr bind)))) (let ([item (assoc var var-map)])
`(,op ,(if item (second item) var) ,(recurse value))))
(define (captured-twice? var) #:variable (lambda (recurse op var)
(let/cc return (let ([item (assoc var var-map)])
(foldl (lambda (subform once?) (if item (second item) var)))))
(if (form-captures? subform var)
(if once? (return #t) #t)
once?))
(at-top-level? var)
(cddr bind))
#f))
(define extra-binds
(filter-not captured-twice?
(filter-not at-top-level?
(second bind))))
`(%lambda ,(second simple-lambda-form) ,(third simple-lambda-form)
(%bind ,(remove* extra-binds (second bind))
,@(map (lambda (subform)
(if (and (pair? subform)
(eq? (first subform) '%set!)
(pair? (third subform))
(eq? (first (third subform)) '%lambda))
(let* ([dest (second subform)]
[value (third subform)]
[g-vars (second value)]
[i-vars (third value)])
`(%set! ,dest ,(foldl (lambda (var temp-value)
(define temp-bind (fourth temp-value))
(if (form-captures? temp-value var)
(narrow-binds
`(%lambda ,g-vars ,i-vars
(%bind (,@(second temp-bind) ,var)
,@(cddr temp-bind))))
temp-value))
value
extra-binds)))
subform))
(cddr bind)))))
(define (flatten-binds form) (define (flatten-binds form)
(define (make-bindings-unique bind rename-vars) (define (make-bindings-unique bind rename-vars)
@ -311,23 +313,22 @@
#:lambda (lambda (recurse . form) form))) #:lambda (lambda (recurse . form) form)))
(define (free-variables form [input? #t] [output? #t]) (define (free-variables form [input? #t] [output? #t])
(map-form form (define (append-map/unique fn . lsts)
(remove-duplicates (apply append-map fn lsts)))
(traverse-form form
#:bind (lambda (recurse op vars . subforms) #:bind (lambda (recurse op vars . subforms)
(remove-duplicates (remove* vars (append-map recurse subforms)))) (remove* vars (append-map/unique recurse subforms)))
#:lambda (lambda (recurse op g-vars i-vars bind)
(recurse bind))
#:set (lambda (recurse op var value) #:set (lambda (recurse op var value)
(let ([value-free (recurse value)]) (let ([value-free (recurse value)])
(if output? (if (and output? (not (memq var value-free)))
(cons var value-free) (cons var value-free)
value-free))) value-free)))
#:primitive (lambda (recurse op . simple-values) #:primitive (lambda (recurse op . simple-values)
(remove-duplicates (append-map recurse simple-values))) (append-map/unique recurse simple-values))
#:simple (lambda (recurse kind form) #:simple (lambda (recurse kind form) '())
(if (and input? #:variable (lambda (recurse kind var)
(variable-value? form) (if (and input? (not (special-variable? var)))
(not (memq form '(%nil %self %argv %ctx %k)))) (list var)
(list form)
'())))) '()))))
(define (free-input-variables form) (define (free-input-variables form)

2
libcompiler/writer.scm
View File

@ -195,3 +195,5 @@
(variable->code (third form)) (variable->code (third form))
(variable->code (fourth form)))] (variable->code (fourth form)))]
[else (error "Unsupported form:" form)]))) [else (error "Unsupported form:" form)])))
; vim:set sw=2 expandtab: