mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-14 17:50:22 +02:00
Code Activity

elisp updates

Browse source 
(Best-ability ChangeLog annotation added by Christine Lemmer-Webber.)

* module/language/elisp/bindings.scm (get-lexical-binding)
  (get-function-binding): Use cadr instead of fluid-ref on slot.
  (with-fluids**): New procedure.
  (with-symbol-bindings, with-function-bindings): Use with-fluids**.
  Also stop using "make-fluid", use "(list #f #f)" instead as default
  lexical-bindings hashtable value.
  (with-lexical-bindings): Drop the error checking for invalid targets.

* module/language/elisp/boot.el (defun, save-excursion)
  (save-current-buffer, save-restriction, track-mouse, setq-default)
  (catch, condition-case): New macros.
  (omega, eval, gensym, interactive, autoload-do-load, fset, prin1)
  (backtrace-frame, backtrace, %set-eager-macroexpansion-mode): New functions.
  (null, consp, listp, car, cdr, make-symbol, signal): Wrap in eval-and-compile.
  (prog1, cond, or, while): Update to make use of gensym.
  (unwind-protect): Switch from funcall to %funcall.
  (%functionp): Rename from functionp.
  (%indirect-function): Update to use %functionp instead of functionp.
  Add check for if object is null, signaling void-function.  Instead of
  calling symbol-function directly, call via %funcall from the module
  "(language elisp runtime)".
  (fset): Significant additions and refactoring.
  (gload): Renamed from fload.
  (defvaralias, nthcdr, nth, eq): Move functions to a different location.
  (eq): Also stop using null.
  (dolist): Remove quasiquoting, build list manually.
  (random): Fix indentation.
  (progn, eval-when-compile, if, defconst, defvar, setq, let, flet)
  (labels, let*, function, defmacro, quote): Protect as special
  operators by raising error if invoked as a function.

* module/language/elisp/compile-tree-il.scm: Import "(ice-9 format)".
  Export compile-%function.
  (lexical-binding, handle-var-def, defun, valid-symbol-list-arg?)
  (process-options!): Remove.
  (reference-variable): Adjust functions passed to access-variable.
  (global?): Drop module parameter, use value-slot instead.
  (ensure-globals!, set-variable!, parse-body-1, parse-lambda-list)
  (compile-lambda, defconst, defvar, let, let*, compile-pair): Refactor.
  (reference-function): Use '(elisp-functions) instead of function-slot.
  (bind-lexically?): Drop module parameter, simplify.
  (make-dynlet): Switch from using make-primcall to make-call.
  (find-operator): Switch from using resolve-interface/resolve-module
  to using function-slot.
  (if, defconst, defvar, let, let*, flet, labels, guile-ref)
  (guile-private-ref, guile-primitive, defmacro, `, quote, %funcall)
  (%set-lexical-binding-mode): Add error checking.
  (setq): Pass in args to report-error.
  (function): Simplified, now calling %function.
  (%function): New function, based on prior "function".  Refactor, including
  adding support for matching against a closure.
  (%set-lexical-binding-mode): Switch from using fluid-set! to
  set-lexical-binding-mode.
  (special-operators): New variable.  Build from following for-each
  statement.
  (compile-tree-il): Drop call to "process-options!"

* module/language/elisp/lexer.scm: Import "(language elisp runtime)".
  (lex): Switch from using "list->string" to "make-lisp-string".

* module/language/elisp/runtime.scm: Use modules "(ice-9 format)",
  "(system base compile)".
  Remove from export list list, removing ensure-fluid!, symbol-fluid!,
  set-symbol-fluid!.  Add to export list ensure-dynamic!, symbol-name,
  symbol-plist, set-symbol-plist!, bind-symbol, symbol-desc, proclaim-symbol!
  special? emacs! unbound, lexical-binding?, set-lexical-binding-mode,
  log!, eval-elisp, local-eval-elisp, make-lisp-string, lisp-string?
  (make-list-string, lisp-string?) New function aliases.
  (value-slot-module, function-slot-module): Adjust module resolution.
  (nil_, t_): New variables.
  (ensure-fluid!, symbol-fluid, set-symbol-fluid!): Removed.
  (lexical-binding, unbound): New variables.
  (lexical-binding?, set-lexical-binding-mode, unbound, dynamic?)
  (make-dynamic, dynamic-ref, dynamic-set!, dynamic-unset!)
  (dynamic-bound?, dynamic-bind, ensure-present!, ensure-desc!)
  (schemify, symbol-name, symbol-desc, ensure-dynamic!, symbol-dynamic)
  (set-symbol-plist!, special?, proclaim-special!, emacs!, eval-elisp)
  (make-string): New procedures.
  (symbol-value): Use dynamic-ref! instead of fluid-ref!.
  (set-symbol-value!): Use dynamic-set! instead of fluid-set!.
  (symbol-function, set-symbol-function!, symbol-bound?)
  (symbol-fbound?, makunbound!, fmakunbound!): Refactor, including
  adjusting how module resolution is being done.

* module/language/elisp/spec.scm: Import module "(system vm vm)".
  Setup elisp-symbols, elisp-functions, elisp-plists.
  Use "set-default-vm-engine!" and "set-vm-engine!" to be set to
  'debug.
  (elisp): Comment out joiner.
This commit is contained in:
Robin Templeton 2014-06-02 20:01:55 -04:00 • committed by Christine Lemmer-Webber
parent ad3d498d31
commit cf5e02f1a6
No known key found for this signature in database
GPG key ID: 4BC025925FF8F4D3
6 changed files with 582 additions and 276 deletions
Download patch file Download diff file Expand all files Collapse all files

371
module/language/elisp/compile-tree-il.scm
View file

@ -30,6 +30,7 @@
#:use-module (srfi srfi-8)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (ice-9 format)
#:export (compile-tree-il
compile-progn
compile-eval-when-compile
@ -44,6 +45,7 @@
compile-guile-ref
compile-guile-private-ref
compile-guile-primitive
compile-%function
compile-function
compile-defmacro
compile-defun
@ -61,8 +63,6 @@
(define bindings-data (make-fluid))
(define lexical-binding (make-fluid))
;;; Find the source properties of some parsed expression if there are
;;; any associated with it.
@ -122,28 +122,29 @@
loc
symbol
(lambda (lexical)
(make-lexical-ref loc lexical lexical))
(if (symbol? lexical)
(make-lexical-ref loc symbol lexical)
(make-call loc lexical '())))
(lambda ()
(call-primitive loc
'fluid-ref
(make-module-ref loc value-slot symbol #t)))))
(make-call loc
(make-module-ref loc runtime 'symbol-value #t)
(list (make-const loc symbol))))))
(define (global? module symbol)
(module-variable module symbol))
(define (global? symbol)
(module-variable value-slot symbol))
(define (ensure-globals! loc names body)
(if (and (every (cut global? (resolve-module value-slot) <>) names)
(if (and (every global? names)
(every symbol-interned? names))
body
(list->seq
loc
`(,@(map
(lambda (name)
(ensure-fluid! value-slot name)
(symbol-desc name)
(make-call loc
(make-module-ref loc runtime 'ensure-fluid! #t)
(list (make-const loc value-slot)
(make-const loc name))))
(make-module-ref loc runtime 'symbol-desc #t)
(list (make-const loc name))))
names)
,body))))
@ -152,15 +153,17 @@
loc
symbol
(lambda (lexical)
(make-lexical-set loc lexical lexical value))
(if (symbol? lexical)
(make-lexical-set loc symbol lexical value)
(make-call loc lexical (list value))))
(lambda ()
(ensure-globals!
loc
(list symbol)
(call-primitive loc
'fluid-set!
(make-module-ref loc value-slot symbol #t)
value)))))
(make-call loc
(make-module-ref loc runtime 'set-symbol-value! #t)
(list (make-const loc symbol)
value))))))
(define (access-function loc symbol handle-lexical handle-global)
(cond
@ -174,7 +177,8 @@
loc
symbol
(lambda (gensym) (make-lexical-ref loc symbol gensym))
(lambda () (make-module-ref loc function-slot symbol #t))))
(lambda ()
(make-module-ref loc '(elisp-functions) symbol #t))))
(define (set-function! loc symbol value)
(access-function
@ -187,15 +191,12 @@
(make-module-ref loc runtime 'set-symbol-function! #t)
(list (make-const loc symbol) value)))))
(define (bind-lexically? sym module decls)
(or (eq? module function-slot)
(let ((decl (assq-ref decls sym)))
(and (equal? module value-slot)
(or
(eq? decl 'lexical)
(and
(fluid-ref lexical-binding)
(not (global? (resolve-module module) sym))))))))
(define (bind-lexically? sym decls)
(let ((decl (assq-ref decls sym)))
(or (eq? decl 'lexical)
(and
(lexical-binding?)
(not (special? sym))))))
(define (parse-let-binding loc binding)
(pmatch binding
@ -234,11 +235,14 @@
(pmatch lst
(((declare . ,x) . ,tail)
(loop tail (append-reverse x decls) intspec doc))
(((interactive . ,x) . ,tail)
(((interactive) . ,tail)
(guard lambda? (not intspec))
(loop tail decls x doc))
(loop tail decls (cons 'interactive-form #nil) doc))
(((interactive ,x) . ,tail)
(guard lambda? (not intspec))
(loop tail decls (cons 'interactive-form x) doc))
((,x . ,tail)
(guard lambda? (string? x) (not doc) (not (null? tail)))
(guard lambda? (or (string? x) (lisp-string? x)) (not doc) (not (null? tail)))
(loop tail decls intspec x))
(else
(values (append-map parse-declaration decls)
@ -257,13 +261,14 @@
;;; optional and rest arguments.
(define (parse-lambda-list lst)
(define (%match lst null optional rest symbol)
(define (%match lst null optional rest symbol list*)
(pmatch lst
(() (null))
(nil (null))
((&optional . ,tail) (optional tail))
((&rest . ,tail) (rest tail))
((,arg . ,tail) (guard (symbol? arg)) (symbol arg tail))
((,arg . ,tail) (guard (list? arg)) (list* arg tail))
(else (fail))))
(define (return rreq ropt rest)
(values #t (reverse rreq) (reverse ropt) rest))
@ -274,24 +279,28 @@
(lambda () (return rreq '() #f))
(lambda (tail) (parse-opt tail rreq '()))
(lambda (tail) (parse-rest tail rreq '()))
(lambda (arg tail) (parse-req tail (cons arg rreq)))))
(lambda (arg tail) (parse-req tail (cons arg rreq)))
(lambda (arg tail) (fail))))
(define (parse-opt lst rreq ropt)
(%match lst
(lambda () (return rreq ropt #f))
(lambda (tail) (fail))
(lambda (tail) (parse-rest tail rreq ropt))
(lambda (arg tail) (parse-opt tail rreq (cons (list arg) ropt)))
(lambda (arg tail) (parse-opt tail rreq (cons arg ropt)))))
(define (parse-rest lst rreq ropt)
(%match lst
(lambda () (fail))
(lambda (tail) (fail))
(lambda (tail) (fail))
(lambda (arg tail) (parse-post-rest tail rreq ropt arg))))
(lambda (arg tail) (parse-post-rest tail rreq ropt arg))
(lambda (arg tail) (fail))))
(define (parse-post-rest lst rreq ropt rest)
(%match lst
(lambda () (return rreq ropt rest))
(lambda () (fail))
(lambda () (fail))
(lambda (arg tail) (fail))
(lambda (arg tail) (fail))))
(parse-req lst '()))
@ -308,30 +317,30 @@
(let lp ((f f) (v v))
(if (null? f)
body
(make-primcall
src 'with-fluid*
(list (make-lexical-ref #f 'fluid (car f))
(make-lexical-ref #f 'val (car v))
(make-lambda
src '()
(make-lambda-case
src '() #f #f #f '() '()
(lp (cdr f) (cdr v))
#f))))))))))
(make-call src
(make-module-ref src runtime 'bind-symbol #t)
(list (make-lexical-ref #f 'fluid (car f))
(make-lexical-ref #f 'val (car v))
(make-lambda
src '()
(make-lambda-case
src '() #f #f #f '() '()
(lp (cdr f) (cdr v))
#f))))))))))
(define (compile-lambda loc meta args body)
(receive (valid? req-ids opt-ids rest-id)
(receive (valid? req-ids opts rest-id)
(parse-lambda-list args)
(if valid?
(let* ((all-ids (append req-ids
opt-ids
(and opts (map car opts))
(or (and=> rest-id list) '())))
(all-vars (map (lambda (ignore) (gensym)) all-ids)))
(let*-values (((decls intspec doc forms)
(parse-lambda-body body))
((lexical dynamic)
(partition
(compose (cut bind-lexically? <> value-slot decls)
(compose (cut bind-lexically? <> decls)
car)
(map list all-ids all-vars)))
((lexical-ids lexical-vars) (unzip2 lexical))
@ -361,50 +370,42 @@
tree-il
(make-dynlet
loc
(map (cut make-module-ref loc value-slot <> #t)
dynamic-ids)
(map (cut make-const loc <>) dynamic-ids)
(map (cut make-lexical-ref loc <> <>)
dynamic-ids
dynamic-vars)
tree-il))))
(make-simple-lambda loc
meta
(append (if intspec
(list intspec)
'())
(if doc
(list (cons 'emacs-documentation doc))
'())
meta)
req-ids
opt-ids
(map (const (nil-value loc))
opt-ids)
(map car opts)
(map (lambda (x)
(if (pair? (cdr x))
(compile-expr (car (cdr x)))
(make-const loc #nil)))
opts)
rest-id
all-vars
full-body)))))))))
(report-error "invalid function" `(lambda ,args ,@body)))))
;;; Handle the common part of defconst and defvar, that is, checking for
;;; a correct doc string and arguments as well as maybe in the future
;;; handling the docstring somehow.
(define (handle-var-def loc sym doc)
(cond
((not (symbol? sym)) (report-error loc "expected symbol, got" sym))
((> (length doc) 1) (report-error loc "too many arguments to defvar"))
((and (not (null? doc)) (not (string? (car doc))))
(report-error loc "expected string as third argument of defvar, got"
(car doc)))
;; TODO: Handle doc string if present.
(else #t)))
;;; Handle macro and special operator bindings.
(define (find-operator name type)
(and
(symbol? name)
(module-defined? (resolve-interface function-slot) name)
(let ((op (module-ref (resolve-module function-slot) name)))
(module-defined? function-slot name)
(let ((op (module-ref function-slot name)))
(if (and (pair? op) (eq? (car op) type))
(cdr op)
#f))))
;;; See if a (backquoted) expression contains any unquotes.
(define (contains-unquotes? expr)
(if (pair? expr)
(if (or (unquote? (car expr)) (unquote-splicing? (car expr)))
@ -475,41 +476,47 @@
(call-primitive loc 'not
(call-primitive loc 'nil? (compile-expr cond)))
(compile-expr then)
(compile-expr `(progn ,@else))))))
(compile-expr `(progn ,@else))))
(else (report-error loc "Bad if" args))))
(defspecial defconst (loc args)
(pmatch args
((,sym ,value . ,doc)
(if (handle-var-def loc sym doc)
(make-seq loc
(set-variable! loc sym (compile-expr value))
(make-const loc sym))))))
(make-seq
loc
(make-call loc
(make-module-ref loc runtime 'proclaim-special! #t)
(list (make-const loc sym)))
(make-seq loc
(set-variable! loc sym (compile-expr value))
(make-const loc sym))))
(else (report-error loc "Bad defconst" args))))
(defspecial defvar (loc args)
(pmatch args
((,sym) (make-const loc sym))
((,sym)
(make-seq loc
(make-call loc
(make-module-ref loc runtime 'proclaim-special! #t)
(list (make-const loc sym)))
(make-const loc sym)))
((,sym ,value . ,doc)
(if (handle-var-def loc sym doc)
(make-seq
loc
(make-conditional
loc
(make-conditional
loc
(call-primitive
loc
'module-bound?
(call-primitive loc
'resolve-interface
(make-const loc value-slot))
(make-const loc sym))
(call-primitive loc
'fluid-bound?
(make-module-ref loc value-slot sym #t))
(make-const loc #f))
(make-void loc)
(set-variable! loc sym (compile-expr value)))
(make-const loc sym))))))
(make-seq
loc
(make-call loc
(make-module-ref loc runtime 'proclaim-special! #t)
(list (make-const loc sym)))
(make-seq
loc
(make-conditional
loc
(make-call loc
(make-module-ref loc runtime 'symbol-bound? #t)
(list (make-const loc sym)))
(make-void loc)
(set-variable! loc sym (compile-expr value)))
(make-const loc sym))))
(else (report-error loc "Bad defvar" args))))
(defspecial setq (loc args)
(define (car* x) (if (null? x) '() (car x)))
@ -524,7 +531,7 @@
(let ((sym (car args))
(val (compile-expr (cadr* args))))
(if (not (symbol? sym))
(report-error loc "expected symbol in setq")
(report-error loc "expected symbol in setq" args)
(cons
(set-variable! loc sym val)
(loop (cddr* args)
@ -537,7 +544,7 @@
(receive (decls forms) (parse-body body)
(receive (lexical dynamic)
(partition
(compose (cut bind-lexically? <> value-slot decls)
(compose (cut bind-lexically? <> decls)
car)
bindings)
(let ((make-values (lambda (for)
@ -549,12 +556,7 @@
(map car dynamic)
(if (null? lexical)
(make-dynlet loc
(map (compose (cut make-module-ref
loc
value-slot
<>
#t)
car)
(map (compose (cut make-const loc <>) car)
dynamic)
(map (compose compile-expr cdr)
dynamic)
@ -577,13 +579,10 @@
(make-body)
(make-dynlet loc
(map
(compose
(cut make-module-ref
loc
value-slot
<>
#t)
car)
(compose (cut make-const
loc
<>)
car)
dynamic)
(map
(lambda (sym)
@ -592,7 +591,8 @@
sym
sym))
dynamic-syms)
(make-body))))))))))))))))
(make-body))))))))))))))
(else (report-error loc "bad let args"))))
(defspecial let* (loc args)
(pmatch args
@ -604,7 +604,7 @@
(compile-expr `(progn ,@forms))
(let ((sym (caar tail))
(value (compile-expr (cdar tail))))
(if (bind-lexically? sym value-slot decls)
(if (bind-lexically? sym decls)
(let ((target (gensym)))
(make-let loc
`(,target)
@ -619,9 +619,10 @@
loc
(list sym)
(make-dynlet loc
(list (make-module-ref loc value-slot sym #t))
(list (make-const loc sym))
(list value)
(iterate (cdr tail)))))))))))))
(iterate (cdr tail)))))))))))
(else (report-error loc "Bad let*" args))))
(defspecial flet (loc args)
(pmatch args
@ -640,7 +641,8 @@
names
gensyms
(map compile-expr vals)
(compile-expr `(progn ,@forms)))))))))))
(compile-expr `(progn ,@forms)))))))))
(else (report-error loc "bad flet" args))))
(defspecial labels (loc args)
(pmatch args
@ -660,7 +662,8 @@
names
gensyms
(map compile-expr vals)
(compile-expr `(progn ,@forms)))))))))))
(compile-expr `(progn ,@forms)))))))))
(else (report-error loc "bad labels" args))))
;;; guile-ref allows building TreeIL's module references from within
;;; elisp as a way to access data within the Guile universe. The module
@ -670,12 +673,14 @@
(defspecial guile-ref (loc args)
(pmatch args
((,module ,sym) (guard (and (list? module) (symbol? sym)))
(make-module-ref loc module sym #t))))
(make-module-ref loc module sym #t))
(else (report-error loc "bad guile-ref" args))))
(defspecial guile-private-ref (loc args)
(pmatch args
((,module ,sym) (guard (and (list? module) (symbol? sym)))
(make-module-ref loc module sym #f))))
(make-module-ref loc module sym #f))
(else (report-error loc "bad guile-private-ref" args))))
;;; guile-primitive allows to create primitive references, which are
;;; still a little faster.
@ -683,14 +688,46 @@
(defspecial guile-primitive (loc args)
(pmatch args
((,sym)
(make-primitive-ref loc sym))))
(make-primitive-ref loc sym))
(else (report-error loc "bad guile-primitive" args))))
(defspecial function (loc args)
(defspecial %function (loc args)
(pmatch args
(((lambda ,args . ,body))
(compile-lambda loc '() args body))
(((closure ,env ,args . ,body))
(let ((bindings (map (lambda (x) (list (car x) (cdr x)))
(filter pair? env))))
(compile-expr
(let ((form `(let ,bindings
(declare ,@(map (lambda (x) (list 'lexical x))
bindings))
(function (lambda ,args
(declare
(lexical
,@(filter-map
(lambda (x)
(cond
((memq x '(&optional &rest))
#f)
((symbol? x)
x)
((list? x)
(car x))))
args)))
,@body)))))
form))))
((,sym) (guard (symbol? sym))
(reference-function loc sym))))
(reference-function loc sym))
((,x)
(make-const loc x))
(else (report-error loc "bad function" args))))
(defspecial function (loc args)
(pmatch args
((,sym) (guard (symbol? sym))
(make-const loc sym))
(else ((cdr compile-%function) loc args))))
(defspecial defmacro (loc args)
(pmatch args
@ -715,44 +752,60 @@
(with-native-target
(lambda ()
(compile tree-il #:from 'tree-il #:to 'value)))
tree-il)))))
(defspecial defun (loc args)
(pmatch args
((,name ,args . ,body)
(if (not (symbol? name))
(report-error loc "expected symbol as function name" name)
(make-seq loc
(set-function! loc
name
(compile-lambda loc
`((name . ,name))
args
body))
(make-const loc name))))))
tree-il)))
(else (report-error loc "bad defmacro" args))))
(defspecial #{`}# (loc args)
(pmatch args
((,val)
(process-backquote loc val))))
(process-backquote loc val))
(else (report-error loc "bad backquote" args))))
(defspecial quote (loc args)
(pmatch args
((,val)
(make-const loc val))))
(make-const loc val))
(else (report-error loc "bad quote" args))))
(defspecial %funcall (loc args)
(pmatch args
((,function . ,arguments)
(make-call loc
(compile-expr function)
(map compile-expr arguments)))))
(map compile-expr arguments)))
(else (report-error loc "bad %funcall" args))))
(defspecial %set-lexical-binding-mode (loc args)
(pmatch args
((,val)
(fluid-set! lexical-binding val)
(make-void loc))))
(set-lexical-binding-mode val)
(make-void loc))
(else (report-error loc "bad %set-lexical-binding-mode" args))))
(define special-operators (make-hash-table))
(for-each
(lambda (pair) (hashq-set! special-operators (car pair) (cddr pair)))
`((progn . ,compile-progn)
(eval-when-compile . ,compile-eval-when-compile)
(if . ,compile-if)
(defconst . ,compile-defconst)
(defvar . ,compile-defvar)
(setq . ,compile-setq)
(let . ,compile-let)
(flet . ,compile-flet)
(labels . ,compile-labels)
(let* . ,compile-let*)
(guile-ref . ,compile-guile-ref)
(guile-private-ref . ,compile-guile-private-ref)
(guile-primitive . ,compile-guile-primitive)
(%function . ,compile-%function)
(function . ,compile-function)
(defmacro . ,compile-defmacro)
(#{`}# . ,#{compile-`}#)
(quote . ,compile-quote)
(%funcall . ,compile-%funcall)
(%set-lexical-binding-mode . ,compile-%set-lexical-binding-mode)))
;;; Compile a compound expression to Tree-IL.
@ -760,14 +813,14 @@
(let ((operator (car expr))
(arguments (cdr expr)))
(cond
((find-operator operator 'special-operator)
=> (lambda (special-operator-function)
(special-operator-function loc arguments)))
((find-operator operator 'macro)
=> (lambda (macro-function)
(compile-expr (apply macro-function arguments))))
((hashq-ref special-operators operator)
=> (lambda (special-operator-function)
(special-operator-function loc arguments)))
(else
(compile-expr `(%funcall (function ,operator) ,@arguments))))))
(compile-expr `(%funcall (%function ,operator) ,@arguments))))))
;;; Compile a symbol expression. This is a variable reference or maybe
;;; some special value like nil.
@ -789,31 +842,9 @@
(compile-pair loc expr))
(else (make-const loc expr)))))
;;; Process the compiler options.
;;; FIXME: Why is '(()) passed as options by the REPL?
(define (valid-symbol-list-arg? value)
(or (eq? value 'all)
(and (list? value) (and-map symbol? value))))
(define (process-options! opt)
(if (and (not (null? opt))
(not (equal? opt '(()))))
(if (null? (cdr opt))
(report-error #f "Invalid compiler options" opt)
(let ((key (car opt))
(value (cadr opt)))
(case key
((#:warnings #:to-file?) ; ignore
#f)
(else (report-error #f
"Invalid compiler option"
key)))))))
(define (compile-tree-il expr env opts)
(values
(with-fluids ((bindings-data (make-bindings)))
(process-options! opts)
(compile-expr expr))
env
env))