Changeset 8510


Ignore:
Timestamp:
02/09/05 18:33:07 (16 years ago)
Author:
piso
Message:

GET-FUNCTION-INFO-VALUE
SET-FUNCTION-INFO-VALUE

Location:
trunk/j/src/org/armedbear/lisp
Files:
3 edited

Legend:

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

    r8198 r8510  
    22 * Autoload.java
    33 *
    4  * Copyright (C) 2003-2004 Peter Graves
    5  * $Id: Autoload.java,v 1.210 2004-11-28 15:43:49 piso Exp $
     4 * Copyright (C) 2003-2005 Peter Graves
     5 * $Id: Autoload.java,v 1.211 2005-02-09 18:32:10 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    115115                    System.exit(-1);
    116116                }
    117             }       
     117            }
    118118        }
    119119    }
     
    491491        autoload(PACKAGE_SYS, "function-info", "function_info");
    492492        autoload(PACKAGE_SYS, "generic-function-discriminating-function", "GenericFunction");
     493        autoload(PACKAGE_SYS, "get-function-info-value", "function_info");
    493494        autoload(PACKAGE_SYS, "hash-table-entries", "HashTableFunctions");
    494495        autoload(PACKAGE_SYS, "hash-table-entries", "HashTableFunctions");
     
    511512        autoload(PACKAGE_SYS, "puthash", "HashTableFunctions");
    512513        autoload(PACKAGE_SYS, "simple-list-remove-duplicates", "simple_list_remove_duplicates");
     514        autoload(PACKAGE_SYS, "set-function-info-value", "function_info");
    513515        autoload(PACKAGE_SYS, "std-instance-slots", "StandardObjectFunctions");
    514516        autoload(PACKAGE_SYS, "std-slot-boundp", "StandardObjectFunctions");
  • trunk/j/src/org/armedbear/lisp/function_info.java

    r8087 r8510  
    22 * function_info.java
    33 *
    4  * Copyright (C) 2004 Peter Graves
    5  * $Id: function_info.java,v 1.4 2004-11-03 15:39:02 piso Exp $
     4 * Copyright (C) 2004-2005 Peter Graves
     5 * $Id: function_info.java,v 1.5 2005-02-09 18:30:36 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    3939    };
    4040
    41     // ### %set-function-info name value
     41    // ### %set-function-info name info
    4242    private static final Primitive _SET_FUNCTION_INFO =
    4343        new Primitive("%set-function-info", PACKAGE_SYS, false)
    4444    {
    45         public LispObject execute(LispObject first, LispObject second)
     45        public LispObject execute(LispObject name, LispObject info)
    4646            throws ConditionThrowable
    4747        {
    48             if (second == NIL)
    49                 FUNCTION_TABLE.remhash(first);
    50             FUNCTION_TABLE.put(first, second);
    51             return second;
     48            if (info == NIL)
     49                FUNCTION_TABLE.remhash(name);
     50            else
     51                FUNCTION_TABLE.put(name, info);
     52            return info;
     53        }
     54    };
     55
     56    // ### get-function-info-value name indicator => value
     57    private static final Primitive GET_FUNCTION_INFO_VALUE =
     58        new Primitive("get-function-info-value", PACKAGE_SYS, true,
     59                      "name indicator")
     60    {
     61        public LispObject execute(LispObject name, LispObject indicator)
     62            throws ConditionThrowable
     63        {
     64            // info is an alist
     65            LispObject info = FUNCTION_TABLE.get(name);
     66            if (info != null) {
     67                while (info != NIL) {
     68                    LispObject cons = info.car();
     69                    if (cons instanceof Cons) {
     70                        if (cons.car().eql(indicator)) {
     71                            // Found it.
     72                            return LispThread.currentThread().setValues(cons.cdr(), T);
     73                        }
     74                    } else if (cons != NIL)
     75                        signal(new TypeError(cons, Symbol.LIST));
     76                    info = info.cdr();
     77                }
     78            }
     79            return LispThread.currentThread().setValues(NIL, NIL);
     80        }
     81    };
     82
     83    // ### set-function-info-value name indicator value => value
     84    private static final Primitive SET_FUNCTION_INFO_VALUE =
     85        new Primitive("set-function-info-value", PACKAGE_SYS, true,
     86                      "name indicator value")
     87    {
     88        public LispObject execute(LispObject name, LispObject indicator,
     89                                  LispObject value)
     90            throws ConditionThrowable
     91        {
     92            // info is an alist
     93            LispObject info = FUNCTION_TABLE.get(name);
     94            if (info == null)
     95                info = NIL;
     96            LispObject alist = info;
     97            while (alist != NIL) {
     98                LispObject cons = alist.car();
     99                if (cons instanceof Cons) {
     100                    if (cons.car().eql(indicator)) {
     101                        // Found it.
     102                        cons.setCdr(value);
     103                        return value;
     104                    }
     105                } else if (cons != NIL)
     106                    signal(new TypeError(cons, Symbol.LIST));
     107                alist = alist.cdr();
     108            }
     109            // Not found.
     110            FUNCTION_TABLE.put(name, info.push(new Cons(indicator, value)));
     111            return value;
    52112        }
    53113    };
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r8505 r8510  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.393 2005-02-08 16:42:51 piso Exp $
     4;;; $Id: jvm.lisp,v 1.394 2005-02-09 18:33:07 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    4949
    5050(defun inline-expansion (name)
    51   (let ((info (sys::function-info name)))
    52     (and info (getf info :inline-expansion))))
     51  (sys:get-function-info-value name :inline-expansion))
    5352
    5453(defun (setf inline-expansion) (expansion name)
    55   (let ((info (sys::function-info name)))
    56     (setf info (sys::%putf info :inline-expansion expansion))
    57     (setf (sys::function-info name) info))
    58   expansion)
     54  (sys:set-function-info-value name :inline-expansion expansion))
    5955
    6056;; Just an experiment...
Note: See TracChangeset for help on using the changeset viewer.