From b48bc215807cb23a8b2f779b435191f0ab9aa1f9 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Fri, 7 May 2010 21:18:50 +0200 Subject: [PATCH] New function to create the root environment for each toplevel form --- src/cmp/cmpenv-api.lsp | 14 ++++++++++++-- src/cmp/cmptop.lsp | 6 ++++-- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/src/cmp/cmpenv-api.lsp b/src/cmp/cmpenv-api.lsp index ba90cd285..377c8d419 100644 --- a/src/cmp/cmpenv-api.lsp +++ b/src/cmp/cmpenv-api.lsp @@ -14,8 +14,18 @@ (in-package #-new-cmp "COMPILER" #+new-cmp "C-ENV") -(defmacro cmp-env-new () - '(cons nil nil)) +(defun cmp-env-new () + (cons nil nil)) + +(defun cmp-env-root (&optional (env *cmp-env-root*)) + "Provide a root environment for toplevel forms storing all declarations +that are susceptible to be changed by PROCLAIM." + (let* ((env (cmp-env-copy env))) + (destructuring-bind (debug safety space speed) + (cmp-env-all-optimizations env) + (add-one-declaration env `(optimize + (speed ,speed) (space ,space) + (debug ,debug) (safety ,safety)))))) (defun cmp-env-copy (&optional (env *cmp-env*)) (cons (car env) (cdr env))) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index 1a2e2c8f2..edc554a5c 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -16,7 +16,9 @@ (defun t1expr (form) (let* ((*current-toplevel-form* nil) - (*cmp-env* (cmp-env-copy (or *cmp-env* *cmp-env-root*)))) + (*cmp-env* (if *cmp-env* + (cmp-env-copy *cmp-env*) + (cmp-env-root)))) (push (t1expr* form) *top-level-forms*))) (defvar *toplevel-forms-to-print* @@ -651,7 +653,7 @@ (*ihs-used-p* nil) (*reservation-cmacro* (next-cmacro)) (*inline-blocks* 1) - (*cmp-env* (cmp-env-copy (fun-cmp-env fun)))) + (*cmp-env* (c1form-env lambda-expr))) (wt-nl1 "{") (wt " VT" *reservation-cmacro* " VLEX" *reservation-cmacro*