Changeset 4663


Ignore:
Timestamp:
11/07/03 16:17:24 (18 years ago)
Author:
piso
Message:

PROCESS-OPTIMIZATION-DECLARATIONS, COMPILE

File:
1 edited

Legend:

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

    r4661 r4663  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.12 2003-11-06 17:14:50 piso Exp $
     4;;; $Id: jvm.lisp,v 1.13 2003-11-07 16:17:24 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    20232023(install-handler '-    'compile-minus)
    20242024
    2025 #+nil
     2025(defun process-optimization-declarations (forms)
     2026  (let (alist ())
     2027    (dolist (form forms)
     2028      (unless (and (consp form) (eq (car form) 'declare))
     2029        (return))
     2030      (let ((decl (cadr form)))
     2031        (when (eq (car decl) 'optimize)
     2032          (dolist (spec (cdr decl))
     2033            (let ((val 3)
     2034                  (quantity spec))
     2035              (if (consp spec)
     2036                  (setq quantity (car spec) val (cadr spec)))
     2037              (if (and (fixnump val) (<= 0 val 3) (memq quantity '(debug speed space safety compilation-speed)))
     2038                  (push (cons quantity val) alist)))))))
     2039    alist))
     2040
    20262041(defun compile (name &optional definition)
    2027   (jvm:jvm-compile name definition))
     2042  (if (consp name)
     2043      (return-from compile (values name nil nil)))
     2044  (if (and name (fboundp name) (typep (symbol-function name) 'generic-function))
     2045      (return-from compile (values name nil nil)))
     2046  (unless definition
     2047    (setq definition (or (and (symbolp name) (macro-function name))
     2048                         (fdefinition name))))
     2049  (let ((expr (get-lambda-to-compile definition))
     2050        (speed nil))
     2051    (when (eq (car expr) 'lambda)
     2052      (let ((decls (process-optimization-declarations (cddr expr))))
     2053        (setf speed (cdr (assoc 'speed decls)))))
     2054    (if (eql speed 3)
     2055        (progn
     2056          (c::%compile name definition)
     2057          (jvm-compile name definition))
     2058        (progn
     2059          (c::%compile name definition)
     2060          ))))
    20282061
    20292062(defmacro defun (name lambda-list &rest body)
    20302063  `(progn
    20312064     (sys::%defun ',name ',lambda-list ',body)
    2032      (compiler::%compile ',name)
    2033      (when *auto-compile*
    2034        (jvm-compile ',name))
     2065     (compile ',name)
    20352066     ',name))
    20362067
Note: See TracChangeset for help on using the changeset viewer.