Ignore:
Timestamp:
02/01/05 14:21:31 (17 years ago)
Author:
piso
Message:

WITH-COMPILATION-UNIT

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r8441 r8442  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.381 2005-02-01 05:20:45 piso Exp $
     4;;; $Id: jvm.lisp,v 1.382 2005-02-01 14:20:29 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    54255425(defvar *catch-errors* t)
    54265426
    5427 (defmacro with-compilation-unit (&body body)
    5428   `(let ((*style-warnings* 0)
    5429          (*warnings* 0)
    5430          (*errors* 0))
    5431      (unwind-protect
    5432       (progn ,@body)
    5433       (unless (and (zerop *warnings*) (zerop *style-warnings*))
    5434         (format t "~%; Compilation unit finished~%")
    5435         (unless (zerop *warnings*)
    5436           (format t ";   Caught ~D WARNING condition~P~%"
    5437                   *warnings* *warnings*))
    5438         (unless (zerop *style-warnings*)
    5439           (format t ";   Caught ~D STYLE-WARNING condition~P~%"
    5440                   *style-warnings* *style-warnings*))
    5441         (terpri)))))
     5427(defvar *in-compilation-unit* nil)
     5428
     5429(defmacro with-compilation-unit (options &body body)
     5430  `(%with-compilation-unit (lambda () ,@body) ,@options))
     5431
     5432(defun %with-compilation-unit (fn &key override)
     5433  (if (and *in-compilation-unit* (not override))
     5434      (funcall fn)
     5435      (let ((*style-warnings* 0)
     5436            (*warnings* 0)
     5437            (*errors* 0))
     5438        (unwind-protect
     5439            (funcall fn)
     5440          (unless (and (zerop *warnings*) (zerop *style-warnings*))
     5441            (format t "~%; Compilation unit finished~%")
     5442            (unless (zerop *warnings*)
     5443              (format t ";   Caught ~D WARNING condition~P~%"
     5444                      *warnings* *warnings*))
     5445            (unless (zerop *style-warnings*)
     5446              (format t ";   Caught ~D STYLE-WARNING condition~P~%"
     5447                      *style-warnings* *style-warnings*))
     5448            (terpri))))))
    54425449
    54435450(defun %jvm-compile (name definition)
     
    54705477             (warnings-p t)
    54715478             (failure-p t))
    5472         (with-compilation-unit
     5479        (with-compilation-unit ()
    54735480          (let ((filespec (compile-defun name expr env)))
    54745481            (setf compiled-definition (sys:load-compiled-function filespec))
Note: See TracChangeset for help on using the changeset viewer.